perm filename EULER.FAI[GEM,BGB]2 blob
sn#101499 filedate 1974-05-15 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00050 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00006 00002 TITLE EULER - EULER PRIMITIVES - BRUCE G. BAUMGART - JULY 1972.
00010 00003 MKB,MKF,MKE,MKV,MKFRAME. MAKE BFEV NODES.
00014 00004 KLB,KLF,KLE,KLV. KILL BFEV NODES.
00017 00005 WING,INVERT,EVERT MAKE AND CHANGE WING POINTERS.
00021 00006 SUBR(LINKED,ENT1,ENT2) FIND IF TWO FEV ENTITIES ARE LINKED.
00024 00007 ECW,ECCW EDGE FETCHING AROUND FV PERIMETER.
00027 00008 OTHER,VCW,VCCW,FCW,FCCW FACE-VERTEX FETCHING FROM AN EDGE.
00030 00009 BDET,BATT,BGET BODY PARTS LINKING AND BODY GET.
00033 00010 SUBR(MKBFV) MAKE DEGENERATE POINT POLYHEDRON.
00035 00011 SUBR(MKEV,FACE,VERTEX) RETURNS NEW VERTEX.
00038 00012 SUBR(MKFE,VERT1,FACE,VERT2) RETURNS NEW EDGE.
00041 00013
00043 00014 SUBR(GLUEE,FACE1,VERT1,FACE2,VERT2) MAKE EDGE AND "HOLE".
00045 00015
00047 00016 SUBR(KLBFEV,Q) KILL B.F.E.V. ENTITY.
00049 00017
00051 00018 SUBR(KLFE,EDGE) KILLS EDGE AND NFACE(EDGE) RETURNS PFACE(EDGE).
00053 00019 SUBR(KLEV,EV) KILLS V AND PED(V). RETURNS OTHER E.
00056 00020 SUBN(KLVE,EDGE) KILLS EDGE & NVT(EDGE). RETURNS PVT(E).
00058 00021 SUBR(UNGLUE,EDGE) RETURN'S FNEW
00062 00022 SUBR(GLUE,FACE1,FACE2)
00065 00023 SUBR(MKCOPY,BODY)
00068 00024
00071 00025 SUBR(SWEEP,FACE0,FLAG)
00074 00026
00077 00027 SUBR(ROTCOM,FACE0) ROTATION SWEEP COMPLETION.
00079 00028 SUBR(PYRAMID,FV) MAKE PYRAMID.
00081 00029 SUBR(FVDUAL,BODY) MAKE FACE-VERTEX DUAL.
00084 00030 SUBR(MKCUBE,DX,DY,DZ)
00086 00031 SUBR(MKCYLN,RADIUS,N,DZ)
00088 00032 SUBR(MKBALL,RADIUS,M,N)
00090 00033 TITLE BIN - BODY INTERSECTION - 7 MARCH 1973 - B.G.BAUMGART
00093 00034 SUBR(BIN,B1,B2) COMPUTE BODY OF INTERSECTION.
00096 00035
00098 00036 SUBR(COMPFE,FACE,EDGE) COMPARE FACE EDGE 3D FOR PIERCING.
00101 00037 SUBR(OTHERV,FACE,VERTEX) FETCH OTHER VERTEX PIERCING FACE.
00103 00038 SUBN(KLSURV,B) KILL SURFACE VERTICES OF A BODY.
00106 00039 SUBN(MKSURF,VERTEX) MAKE SURFACE EDGES AND VERTICES.
00109 00040 SUBN(FIXUP1)
00112 00041 SUBN(QHOLE,VERTEX) DETECT AND PYRAMID POTENTIAL PIERCE HOLES.
00114 00042 SUBR(MKCVEX)F MAKE CONVEX.
00116 00043 GO L6
00118 00044 SCAN FACE1'S PERIMETER VERT1 TO VERT3.
00120 00045 SUBR(ESLURP,BODY) REMOVE UNNECESSARY EDGES.
00123 00046 SUBR(MKBUCK,BODY) MAKE BUCKET CUBE.
00125 00047 SUBR(ECUT,B,DX,DY,DZ)
00128 00048 SUBR(BCUT,B,DX,DY,DZ)
00130 00049 SUBN(FECUT,BODY) FACE EDGE CUTTING.
00133 00050
00135 ENDMK
⊗;
TITLE EULER - EULER PRIMITIVES - BRUCE G. BAUMGART - JULY 1972.
COMMENT /
These routines are based on Euler's formula: F - E + V = 2*(B - H).
Curly bracketed names are not INTERN'ed.
WINGED EDGE PRIMITIVES:
1-5 MKB,MKF,MKE,MKV,MKFRAME. MAKE BFEV NODES.
{KLB},{KLF},{KLE},{KLV}. KILL BFEV NODES.
6,7,8 WING,INVERT,EVERT MAKE AND CHANGE WING POINTERS.
9. SUBR(LINKED,ENT1,ENT2) FIND IF TWO ENTITIES ARE LINKED.
10,11 ECW,ECCW,{EFETCH} EDGE FETCHING AROUND FV PERIMETER.
12-16 OTHER,VCW,VCCW,FCW,FCCW FACE-VERTEX FETCHING FROM AN EDGE.
17-19 BDET,BATT,BGET BODY PARTS LINKING AND BODY GET.
EULER MAKE PRIMITIVES:
1. BNEW ← MKBFV; MAKES POINT POLYHEDRON: 1 FACE, 1 VERTEX.
2. VNEW ← MKEV(F,V); MAKES NEW EDGE AND VERTEX SUCH THAT:
VNEW = NVT(ENEW); V = PVT(ENEW);
VNEW ← ESPLIT(E); MAKES NEW EDGE AND VERTEX...
3. ENEW ← MKFE(V1,F,V2); MAKES NEW FACE AND EDGE SUCH THAT:
FNEW = NFACE(ENEW); F = PFACE(ENEW);
V1 = PVT(ENEW); V2 = NVT(ENEW).
4. ENEW ← GLUEE(F1,V1,F2,V2); MAKES NEW EDGE, KILLS F2,
AND MAKES A HOLE OR KILLS A BODY.
V1 = PVT(ENEW); V2 = NVT(ENEW).
EULER KILL PRIMITIVES:
1. QNEW ← KLBFEV(Q); KILLS BFEV ENTITY. {FKILL},{EKILL}
2. F ← KLFE(E); KILLS E AND NFACE(E). RETURNS PFACE(E).
3. E ← KLEV(V); KILLS V AND PED(V). RETURNS OTHER E OF V.
V ← KLEV(E); KILLS E AND NVT(E). RETURNS PVT(E).
4. FNEW ← UNGLUE(E); KILLS E; MAKES F; RETURNS THE NEW FACE.
AND KILLS A HOLE OR MAKES A BODY.
POLYHEDRON ROUTINES:
1. BODY ← GLUE(FACE1,FACE2); KILL FACE1 & FACE2,
2. QNEW ← MKCOPY(ENTITY); COPY A BODY, FACE, EDGE OR FRAME.
3. FACE ← SWEEP(FACE,FLAG); MAKE PRISM ON FACE (OR SWEEP WIRE).
4. FACE ← ROTCOM(FACE); ROTATION SWEEP WIRE FACE COMPLETION.
5. PEAK ← PYRAMID(FV); MAKE PYRAMID ON A FACE (OR VERTEX).
6. BODY ← FVDUAL(BODY); APPLY FACE-VERTEX DUALITY TO BODY.
7. BNEW ← MKCUBE(DX,DY,DZ); CREATE RIGHT RECTANGULAR PRISM.
8. BNEW ← MKCYLN(RADIUS,N,DZ); CREATE CYLINDER APPROXIMATION.
9. BNEW ← MKBALL(RADIUS,M,N); CREATE SPHERE APPROXIMATION.
BODY INTERSECTION:
/
;MKB,MKF,MKE,MKV,MKFRAME. ;MAKE BFEV NODES.
EXTERN MKNODE,KLNODE,UNIVERSE
.INSERT MN ;MNEMONICS AND FIELD NAMES.
SUBR(MKB,Q) ;MAKE BODY IN THE WORLD OF Q.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{R,S}
CALL(MKNODE,{[BBIT+$BODY]}) ;CREATE NODE.
PUSHP R↔PUSHP S
DIP 1,1↔DAC 1,1(1)↔DAC 1,2(1)↔DAC 1,3(1) ;FEV - RINGS.
SKIPN S,Q↔GO[LAC S,UNIVER↔NWRLD S,S↔GO .+1] ;NOW WORLD.
TESTZ S,BBIT↔CCW S,S↔CW R,S ;GET WORLD.
CW. 1,S↔CCW. S,1↔CCW. 1,R↔CW. R,1 ;WORLD RINGIN.
CDR 1,1↔POPP S↔POPP R↔POP1J ;RETURN BNEW.
ENDR;1/14/73(BGB)----------------------------------------------------
SUBR(MKF,BODY) ;MAKE FACE NODE ON A BODY.
COMMENT .-----------------------------------------------------------.
CALL(MKNODE,{[FBIT+$FACE]}) ;FACE NODE, RING-1.
EXCH 2,BODY↔HLL 2,1(2)↔DAC 2,1(1) ;I POINT AT THEM.
NFACE. 1,2↔MOVSS 2↔PFACE. 1,2 ;THEY POINT AT ME.
EXCH 2,BODY↔POP1J ;RESTORE AC-2.
ENDR MKF;1/13/73(BGB)------------------------------------------------
SUBR(MKE,BODY) ;MAKE EDGE NODE ON A BODY.
COMMENT .-----------------------------------------------------------.
CALL(MKNODE,{[EBIT+$EDGE]}) ;EDGE NODE, RING-2.
EXCH 2,BODY↔HLL 2,2(2)↔DAC 2,2(1)↔CCW. 2,1 ;I POINT AT THEM.
NED. 1,2↔MOVSS 2↔PED. 1,2 ;THEY POINT AT ME.
EXCH 2,BODY↔POP1J ;RESTORE AC-2.
ENDR MKE;1/13/73(BGB)------------------------------------------------
SUBR(MKV,BODY) ;MAKE VERTEX NODE ON A BODY.
COMMENT .-----------------------------------------------------------.
CALL(MKNODE,{[VBIT+$VERT]}) ;VERTEX NODE, RING-3.
EXCH 2,BODY↔HLL 2,3(2)↔DAC 2,3(1) ;I POINT AT THEM.
NVT. 1,2↔MOVSS 2↔PVT. 1,2 ;THEY POINT AT ME.
EXCH 2,BODY↔POP1J ;RESTORE AC-2.
ENDR MKV;1/13/73(BGB)------------------------------------------------
SUBR(MKFRAME) ;MAKE A FRAME OF REFERENCE NODE.
COMMENT .-----------------------------------------------------------.
CALL(MKNODE,[1.0])↔MOVSI(<1.0>)
DAC JY(1)↔DAC KZ(1)↔POP0J
ENDR MKFRAME;3/13/73(BGB)--------------------------------------------
;KLB,KLF,KLE,KLV. ;KILL BFEV NODES.
SUBN(KLB,B) ;KILL A BODY NODE.
COMMENT .-----------------------------------------------------------.
CDR 1,B↔LAC 1,7(1) ;DELETE B FROM BODY RING.
HLLM 1,7(1)↔MOVSS 1↔HLRM 1,7(1) ;BODY RING IS IN 7TH WORD.
CDR 1,B↔FRAME 1,1↔CALL(KLNODE,1);FRAME OF THE BODY.
CALL(KLNODE,B)↔POP1J
ENDR;1/13/73(BGB)----------------------------------------------------
SUBN(KLF,F) ;KILL FACE NODE.
COMMENT .-----------------------------------------------------------.
CDR 1,F↔LAC 1,1(1) ;DELETE F FROM FACE RING.
HLLM 1,1(1)↔MOVSS 1↔HLRM 1,1(1) ;FACE RING IS IN 1ST WORD.
CALL(KLNODE,F)↔POP1J
ENDR;1/13/73(BGB)----------------------------------------------------
SUBN(KLE,E) ;KILL EDGE NODE.
COMMENT .-----------------------------------------------------------.
CDR 1,E↔LAC 1,2(1) ;DELETE E FROM EDGE RING.
HLLM 1,2(1)↔MOVSS 1↔HLRM 1,2(1) ;EDGE RING IS IN 2ND WORD.
CALL(KLNODE,E)↔POP1J
ENDR;1/13/73(BGB)----------------------------------------------------
SUBN(KLV,V) ;KILL VERTEX NODE.
COMMENT .-----------------------------------------------------------.
CDR 1,V↔LAC 1,3(1) ;DELETE V FROM VERTEX RING.
HLLM 1,3(1)↔MOVSS 1↔HLRM 1,3(1) ;VERTEX RING IS IN 3RD WORD.
CALL(KLNODE,V)↔POP1J
ENDR;1/13/73(BGB)----------------------------------------------------
;WING,INVERT,EVERT ;MAKE AND CHANGE WING POINTERS.
SUBR(WING,EDG1,EDG2) ;PLACE WING POINTERS BETWEEN TWO EDGES.
COMMENT .------------------------------------------------------------
THE AC-0 CONTROL BITS:
[0-NV2-NV1] [0-PV2-PV1] [0-NF2-NF1] [0-PF2-PF1].
E1←3 ↔ E2←4
SAVAC(4)↔SETZ↔CDR E1,EDG1↔CDR E2,EDG2
;FIND THE COMMON VERTEX.
;AC-1 ← (NV1,,PV1) ⊗ (NV2,,PV2) NN,,PP IN COMMON.
;AC-2 ← (PV1,,NV1) ⊗ (NV2,,PV2) PN,,NP IN COMMON.
LAC 1,3(E1)↔MOVS 2,1↔XOR 1,3(E2)↔XOR 2,3(E2)
TLNN 1,-1↔TRO 3000↔TRNN 1,-1↔TRO 0300
TLNN 2,-1↔TRO 2100↔TRNN 2,-1↔TRO 1200
;FIND THE COMMON FACE.
LAC 1,1(E1)↔MOVS 2,1↔XOR 1,1(E2)↔XOR 2,1(E2)
TLNN 1,-1↔TRO 0030↔TRNN 1,-1↔TRO 0003
TLNN 2,-1↔TRO 0021↔TRNN 2,-1↔TRO 0012
;STORE THE WINGS AS INDICATED.
SETCA
TRNN 2020↔NCW. E1,E2↔TRNN 1010↔NCW. E2,E1
TRNN 2002↔PCCW. E1,E2↔TRNN 1001↔PCCW. E2,E1
TRNN 0220↔NCCW. E1,E2↔TRNN 0110↔NCCW. E2,E1
TRNN 0202↔PCW. E1,E2↔TRNN 0101↔PCW. E2,E1
GETAC(4)↔POP2J
ENDR;1/13/73(BGB)----------------------------------------------------
SUBR(INVERT,EDGE) ;CHANGE EDGE ORIENTATION.
COMMENT .----------------------------------------------------------.
LAC 1,EDGE
MOVSS 1(1)↔MOVSS 3(1) ;PFACE↔NFACE. PVT↔NVT.
MOVSS 4(1)↔MOVSS 5(1) ;NCW↔NCCW. PCW↔PCCW.
MOVNS AA(1)↔MOVNS BB(1)↔MOVNS CC(1) ;CHANGE SIGN OF ECOEF.
POP1J ;RETURNS THE EDGE.
ENDR;1/14/73(BGB)---------------------------------------------------
SUBR(EVERT,BODY) ;TURN BODY INSIDE OUT.
COMMENT .----------------------------------------------------------.
ACCUMULATORS{B,E}
CDR B,BODY↔TEST B,BBIT↔POP1J↔LAC E,B ;BODY ARGUMENT.
L1: PED E,E↔CAMN E,BODY↔GO L3↔MOVSS 1(E) ;PFACE ↔ NFACE.
MOVS 0,4(E)↔MOVS 1,5(E) ;NCW ↔ PCCW.
DAC 1,4(E)↔DAC 0,5(E)↔GO L1 ;NCCW ↔ PCW.
;FOR ALL THE PARTS OF THIS BODY.
L3: SON 1,B↔JUMPE 1,POP1J. ;EXISTENCE OF PARTS.
L4: PUSH P,1↔CALL(EVERT,1)↔POP P,1 ;RECURSE ON A PART.
LAC B,BODY↔BRO 1,1↔SON 0,B ;NEXT PART.
CAME 0,1↔GO L4↔POP1J
ENDR;1/14/73(BGB)---------------------------------------------------
SUBR(LINKED,ENT1,ENT2) ;FIND IF TWO FEV ENTITIES ARE LINKED.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{Q1,Q2,E}
EXCH Q1,ENT1↔EXCH Q2,ENT2↔PUSHP E
;BRANCH ON THE COMBINATION OF ARGUMENT TYPES.
LDB 0,[POINT 3,(Q1),16]↔LDB 1,[POINT 3,(Q2),16]
CAMLE 0,1↔EXCH Q1,Q2
IOR 1,0↔GO@[FALSE↔FF↔EE↔FE↔VV↔FV↔EV↔FALSE](1)
;FACES WITH COMMON EDGE.
FF: PED E,Q1↔DAC E,E0#
CALL OTHER,E,Q1↔CAMN 1,Q2↔GO TRUE+1 ;RETURN COMMON EDGE.
SETQ(E,{ECCW,E,Q1})↔CAME E,E0↔GO FF+2↔GO FALSE
;EDGE IN FACE PERIMETER.
FE: PFACE 1,Q2↔CAMN 1,Q1↔GO TRUE
NFACE 1,Q2↔CAMN 1,Q1↔GO TRUE↔GO FALSE
;VERTEX IN FACE PERIMETER.
FV: PED E,Q2↔DAC E,E0
JUMPE E,[PFACE 1,Q1↔PVT 0,Q2↔CAME 0,1↔GO FALSE↔GO TRUE]
PFACE 1,E↔CAMN 1,Q1↔GO TRUE↔NFACE 1,E↔CAMN 1,Q1↔GO TRUE
SETQ(E,{ECCW,E,Q2})↔CAME E,E0↔GO FV+2↔GO FALSE
;EDGES WITH A COMMON VERTEX.
EE: PVT 0,Q1↔PVT 1,Q2↔CAMN 0,1↔GO TRUE+1
NVT 1,Q2↔CAMN 0,1↔GO TRUE+1
NVT 0,Q1↔PVT 1,Q2↔CAMN 0,1↔GO TRUE+1
NVT 1,Q2↔CAMN 0,1↔GO TRUE+1↔GO FALSE
;VERTEX IN EDGE.
EV: PVT 1,Q1↔CAMN 1,Q2↔GO TRUE
NVT 1,Q1↔CAMN 1,Q2↔GO TRUE↔GO FALSE
;VERTICES WITH A COMMON EDGE.
VV: PED E,Q1↔DAC E,E0
CALL OTHER,E,Q1↔CAMN 1,Q2↔GO TRUE+1 ;RETURN COMMON EDGE.
SETQ(E,{ECCW,E,Q1})↔CAME E,E0↔GO VV+2↔GO FALSE
FALSE: TDCA 1,1
TRUE: SETO 1,↔POPP E
LAC Q1,ENT1↔LAC Q2,ENT2
POP2J
ENDR;1/13/73(BGB)----------------------------------------------------
;ECW,ECCW ;EDGE FETCHING AROUND FV PERIMETER.
SUBR(ECW,FEV,FV) ;FETCH EDGE CLOCKWISE FROM FEV ABOUT FV.
COMMENT .-----------------------------------------------------------.
CDR 1,FEV↔TEST 1,EBIT↔GO[SETZ↔CALL(EFETCH,FEV,FV)↔POP2J]
PFACE 0,1↔CAMN 0,FV↔GO[PCW 1,1↔POP2J]
NFACE 0,1↔CAMN 0,FV↔GO[NCW 1,1↔POP2J]
PVT 0,1↔CAMN 0,FV↔GO[NCCW 1,1↔POP2J]
NVT 0,1↔CAMN 0,FV↔GO[PCCW 1,1↔POP2J]
FATAL(ECW)
ENDR;1/13/73(BGB)----------------------------------------------------
SUBR(ECCW,FEV,FV) ;FETCH EDGE CCW FROM FEV ABOUT FV.
COMMENT .-----------------------------------------------------------.
CDR 1,FEV↔TEST 1,EBIT↔GO[SETO↔CALL(EFETCH,FEV,FV)↔POP2J]
PFACE 0,1↔CAMN 0,FV↔GO[PCCW 1,1↔POP2J]
NFACE 0,1↔CAMN 0,FV↔GO[NCCW 1,1↔POP2J]
PVT 0,1↔CAMN 0,FV↔GO[PCW 1,1↔POP2J]
NVT 0,1↔CAMN 0,FV↔GO[NCW 1,1↔POP2J]
FATAL(ECCW)
ENDR;1/13/73(BGB)----------------------------------------------------
SUBN(EFETCH,FROMV,ABOUTF)
COMMENT .-----------------------------------------------------------.
;ARGUMENTS: VERTEX DIRECTED EDGE FETCH MANDALA.
;AC0: FLAG=0 RIGHT / \ E ← ERIGHT(FROM-V,ABOUT-F).
;FLAG= -1 LEFT E2 ELEFT ERIGHT E1 E ← ELEFT (FROM-V,ABOUT-F).
ACCUMULATORS{V,F,E1,E2}
DAC 0,FLAG#↔SAVAC(5) ;SAVE THE FLAG & THE AC'S.
LAC V,FROMV↔LAC F,ABOUTF ;FETCH THE ARGUMENTS.
TEST V,VBIT↔GO[SETCMM FLAG ;TEST FOR OPPOSITE SENSE.
EXCH F,V↔GO .+1]
PED E2,V↔DAC E2,E0# ;SCAN EDGES CW ABOUT VERTEX.
L1: LAC E1,E2 ;E2←ECW(E1,V) AND Q←FCW(E1,V).
PVT 0,E1↔CAMN 0,V↔GO[NCCW E2,E1↔NFACE 0,E1↔GO L2]
NVT 0,E1↔CAMN 0,V↔GO[PCCW E2,E1↔PFACE 0,E1↔GO L2]
FATAL(EFETCH)
L2: CAMN 0,F↔GO[LAC 1,E1↔SKIPE FLAG↔LAC 1,E2↔GETAC(5)↔POP2J]
CAME E2,E0↔GO L1↔FATAL(EFETCH)
ENDR EFETCH;1/13/73(BGB)---------------------------------------------
;OTHER,VCW,VCCW,FCW,FCCW FACE-VERTEX FETCHING FROM AN EDGE.
SUBR(OTHER,EDG,FV) ;GET OTHER FACE OR VERTEX OF AN EDGE.
COMMENT .-----------------------------------------------------------.
CDR 1,EDG
PFACE 0,1↔CAMN 0,FV↔GO[NFACE 1,1↔POP2J]
NFACE 0,1↔CAMN 0,FV↔GO[PFACE 1,1↔POP2J]
PVT 0,1↔CAMN 0,FV↔GO[NVT 1,1↔POP2J]
NVT 0,1↔CAMN 0,FV↔GO[PVT 1,1↔POP2J]
FATAL(OTHER)
ENDR;1/13/73(BGB)----------------------------------------------------
SUBR(VCW,EDGE,FACE) ;FETCH VERTEX CLOCKWISE FROM EDGE ABOUT FACE.
COMMENT .-----------------------------------------------------------.
CDR 1,EDGE
PFACE 0,1↔CAMN 0,FACE↔GO[PVT 1,1↔POP2J]
NFACE 0,1↔CAMN 0,FACE↔GO[NVT 1,1↔POP2J]
FATAL(VCW)
ENDR VCW;1/13/73(BGB)------------------------------------------------
SUBR(VCCW,EDGE,FACE) ;FETCH VERTEX CCW FROM EDGE ABOUT FACE.
COMMENT .-----------------------------------------------------------.
CDR 1,EDGE
PFACE 0,1↔CAMN 0,FACE↔GO[NVT 1,1↔POP2J]
NFACE 0,1↔CAMN 0,FACE↔GO[PVT 1,1↔POP2J]
FATAL(VCW)
ENDR VCCW;1/13/73(BGB)-----------------------------------------------
SUBR(FCW,EDGE,VERTEX) ;FETCH FACE CLOCKWISE FROM EDGE ABOUT VERTEX.
COMMENT .-----------------------------------------------------------.
CDR 1,EDGE
PVT 0,1↔CAMN 0,VERTEX↔GO[NFACE 1,1↔POP2J]
NVT 0,1↔CAMN 0,VERTEX↔GO[PFACE 1,1↔POP2J]
FATAL(FCW)
ENDR FCW;1/13/73(BGB)------------------------------------------------
SUBR(FCCW,EDGE,VERTEX) ;FETCH FACE CCW FROM EDGE ABOUT VERTEX.
COMMENT .-----------------------------------------------------------.
CDR 1,EDGE
PVT 0,1↔CAMN 0,VERTEX↔GO[PFACE 1,1↔POP2J]
NVT 0,1↔CAMN 0,VERTEX↔GO[NFACE 1,1↔POP2J]
FATAL(FCCW)
ENDR FCCW;1/13/73(BGB)----------------------------------------------
;BDET,BATT,BGET ;BODY PARTS LINKING AND BODY GET.
SUBR(BDET,BODY) ;BODY DETACH.
COMMENT .-----------------------------------------------------------.
LAC 1,BODY↔TESTZ 1,FBIT+EBIT+VBIT↔POP1J
SKIPN 5(1)↔POP1J↔PUSH P,2↔PUSH P,3
BRO 2,1↔SIS 3,1↔BRO. 2,3↔SIS. 3,2 ;RINGO.
CAMN 2,1↔SETZ 2,
DAD 3,1↔SON 0,3↔CAMN 0,1↔SON. 2,3 ;DAD OUT.
SETZ↔DAD. 0,1↔BRO. 0,1↔SIS. 0,1 ;CLEAR SELF.
POP P,3↔POP P,2↔POP1J
ENDR;2/17/73(BGB)----------------------------------------------------
SUBR(BATT,B1,B2) ;BODY ATTACH B1 TO B2.
COMMENT .-----------------------------------------------------------.
LAC 1,B1↔LAC 2,B2
CAMN 1,2↔POP2J ;PREVENT INCEST.
TESTZ 1,FBIT+EBIT+VBIT↔POP2J
DAD 0,1
JUMPN[CALL(BDET,1)↔GO .+1] ;MAKE B1 AN ORPHAN.
LAC 2,B2
TESTZ 2,FBIT+EBIT+VBIT↔POP2J
DAD. 2,1 ;B2 IS B1'S NEW DADDY.
SON 3,2↔JUMPE 3,[SON. 1,2
BRO. 1,1↔SIS. 1,1↔POP2J] ;FIRST CHILD CASE.
BRO 2,3
BRO. 2,1↔SIS. 1,2 ;MANY CHILD CASE.
SIS. 3,1↔BRO. 1,3↔POP2J
ENDR;2/17/73(BGB)----------------------------------------------------
SUBR(BGET,ENTITY) ;FETCH THE BODY OF AN ENTITY.
COMMENT .-----------------------------------------------------------.
Q←1
CDR Q,ENTITY
L1: MOVM 0,(Q)↔TLNE 0,1B9↔POP1J ;FRAMES LOSE QUICKLY
ANDI 0,17↔ADD 0,[@TABLE]↔GO @0
TABLE: POP1J.↔POP1J.↔POP1J.↔POP1J. ;FRAME,EMTPY,UNIVERSE,LAMP
POP1J.↔POP1J.↔POP1J.↔POP1J. ;CAMERA,WORLD,WINDOW,IMAGE
POP1J.↔POP1J.↔POP1J.↔POP1J. ;TEXT,XNODE,YNODE,ZNODE
POP1J.↔[PFACE 0,Q↔GO L2] ;BODY,FACE
[CCW Q,Q↔POP1J]↔[PVT 0,Q↔GO L2] ;EDGE,VERTEX
L2: PED Q,Q↔JUMPN Q,[CCW Q,Q↔POP1J]
LAC 1,0↔POP1J
ENDR;1/13/73(BGB)----------------------------------------------------
SUBR(MKBFV) ;MAKE DEGENERATE POINT POLYHEDRON.
COMMENT .-----------------------------------------------------------.
SETQ(B#,{MKB,[0]}) ;MAKE THE BODY NODE.
CALL(MKFRAME)↔LAC 2,B↔FRAME. 1,2 ;FRAME OF REFERENCE.
CALL(MKF,B)↔CALL(MKV,B)↔LAC 1,B↔POP0J ;MAKE FACE & VERTEX.
ENDR;2/27/74(BGB)----------------------------------------------------
SUBR(ESPLIT,EDGE) ;LIKE MKEV, RETURNS VERTEX.
COMMENT .----------------------------------------------------------.
ACCUMULATORS{VNEW,ENEW,B,E,V}
;CHECK FOR BAD ARGUMENTS.
CDR VNEW,EDGE
LAC E,VNEW
TEST E,EBIT↔GO L1
PVT V,E
;CREATE A NEW EDGE AND VERTEX.
CCW B,E
SETQ(VNEW,{MKV,B})
SETQ(ENEW,{MKE,B})
MOVSI AA(E)↔HRRI AA(ENEW)↔BLT CC(ENEW)
;PLACE VNEW BETWEEN E AND ENEW.
PED 0,V↔CAMN 0,E↔PED. ENEW,V
PED. ENEW,VNEW
PVT 0,E↔PVT. 0,ENEW
PVT. VNEW,E
NVT. VNEW,ENEW
PFACE 0,E↔PFACE. 0,ENEW
NFACE 0,E↔NFACE. 0,ENEW
;NEW UPPER WINGS ARE LIKE THE OLDE;
PCW 0,E↔CALL(WING,0,ENEW)
NCCW 0,E↔CALL(WING,0,ENEW)
;EDGES POINT AT EACH OTHER ACROSS VNEW.
NCCW. ENEW,E↔PCW. ENEW,E
NCW. E,ENEW↔PCCW. E,ENEW
L1: LAC 1,VNEW↔POP1J
ENDR;1/14/73(BGB)-----------------------------------------------------
SUBR(MKEV,FACE,VERTEX) ;RETURNS NEW VERTEX.
COMMENT .----------------------------------------------------------.
ACCUMULATORS {VNEW,B,F,V,ENEW,E1,E2}
;CHECK FOR BAD ARGUMENTS.
CDR VNEW,VERTEX ;FOR BAD RETURNS.
LAC V,VNEW↔TEST(V,VBIT)↔POP2J
LAC F,FACE↔TEST(F,FBIT)↔POP2J
;CREATE A NEW EDGE AND VERTEX.
SETQ(B,{BGET,V})
SETQ(VNEW,{MKV,B})
MOVSI XWC(V)↔HRRI XWC(VNEW)↔BLT ZWC(VNEW)
MOVSI XPP(V)↔HRRI XPP(VNEW)↔BLT YPP(VNEW)
LAC 1(V)↔DAC 1(VNEW)
SETQ(ENEW,{MKE,B})
;MAKE FACE AND VERTEX LINKS.
PED. ENEW,VNEW
NFACE. F,ENEW
PFACE. F,ENEW
NVT. VNEW,ENEW
PVT. V,ENEW
;CHECK FOR VERTEX BODY CASE.
PED E1,F↔JUMPE E1,[
PED. ENEW,F↔PED. ENEW,V
PCW. ENEW,ENEW↔NCCW. ENEW,ENEW↔GO .+1]
;LOWER WINGS POINT AT SELF.
NCW. ENEW,ENEW
PCCW. ENEW,ENEW
;GET THE UPPER WINGS.
PED E1,V↔LAC E2,E1
NFACE 0,E1↔PFACE 1,E1
CAMN 0,1↔GO L2
L1: LAC E1,E2
SETQ(E2,{ECW,E1,V})
CALL(FCW,E1,V)
CAME 1,F↔GO L1
;TIE ENEW TO ITS UPPER WINGS.
L2: PCW. E1,ENEW↔NCCW. E2,ENEW
PVT 0,E1↔CAME 0,V↔GO[PCCW. ENEW,E1↔GO .+2]↔NCCW. ENEW,E1
PVT 0,E2↔CAME 0,V↔GO[NCW. ENEW,E2↔GO .+2]↔PCW. ENEW,E2
LAC 1,VNEW↔POP2J
ENDR MKEV;1/14/73(BGB)-----------------------------------------------
↓WASP←←1B5 ;EDGE MARKING BIT FOR WAIST OF A WASP FACE.
SUBR(MKFE,VERT1,FACE,VERT2) ;RETURNS NEW EDGE.
COMMENT .-----------------------------------------------------------
MKFE MANDALA
o--------o o--------o
| E2 \ / E1 |
| nccw \ / pcw |
| \ / |
| pvt ⊗ V1 |
| | |
| FNEW ENEW F |
| | |
| nvt ⊗ V2 |
| / \ |
| ncw / \ pccw |
| E3 / \ E4 |
o--------o o--------o .
ACCUMULATORS{V1,F,V2,FNEW,ENEW,E,E0,B,V}
;FETCH THE ARGUMENTS.
CDR V1,VERT1
CDR F,FACE
CDR V2,VERT2
;DO THE CREATIONS.
SETQ(B,{BGET,F})
SETQ(FNEW,{MKF,B})
SETQ(ENEW,{MKE,B})
LAC 4(F)↔DAC 4(FNEW)
LAC 5(F)↔DAC 5(FNEW)
MOVSI AA(F)↔HRRI AA(FNEW)↔BLT CC(FNEW)
;LINK ENEW.
PED. ENEW,F↔ PED. ENEW,FNEW
PFACE. F,ENEW↔ NFACE. FNEW,ENEW
PVT. V1,ENEW↔ NVT. V2,ENEW
;GET THE UPPER WINGS.
PED E,V1↔DAC E,E0↔DAC E,EDGE0#
MOVS 1(E)↔CAMN 1(E)↔GO L1A ;WIRE CASE.
L1: LAC E0,E↔SETQ(E,{ECW,E0,V1})
CALL(FCW,E0,V1)↔CAME 1,F↔GO[
CAME E,EDGE0↔GO L1↔FATAL(MKFE - V1 HAS NO WINGS)]
L1A: DAC E0,E1#↔DAC E,E2#
;GET THE LOWER WINGS.
PED E,V2↔DAC E,E0↔DAC E,EDGE0#
MOVS 1(E)↔CAMN 1(E)↔GO L2A ;WIRE CASE.
L2: LAC E0,E↔SETQ(E,{ECW,E0,V2})
CALL(FCW,E0,V2)↔CAME 1,F↔GO[
CAME E,EDGE0↔GO L2↔FATAL(MKFE - V2 HAS NO WINGS)]
L2A: DAC E0,E3#↔DAC E,E4#
;CDR V2'S TAIL REPLACING F'S WITH FNEW.
LAC E,E3↔LAC V,V2
L3: MOVS 1,1(E)↔CAME 1,1(E)↔GO L4
PFACE. FNEW,E
SETQ(V,{OTHER,E,V})
SETQ(E,{ECCW,E,V})↔GO L3
;CCW FROM V1 REPLACING F'S WITH FNEW.
L4: LAC E0,E↔LAC E,E2↔SETZM A#↔CAMN E0,E2↔GO L6
L5: TESTZ E,WASP↔JSR WASPS
NFACE 0,E↔CAME F,0
GO[PFACE. FNEW,E↔GO .+2]
NFACE. FNEW,E
CAME E,E0
GO[DAC E,A↔SETQ(E,{ECCW,E,FNEW})↔GO L5]
;LINK THE WINGS.
L6: CALL(WING,E1,ENEW)
CALL(WING,E2,ENEW)
CALL(WING,E3,ENEW)
CALL(WING,E4,ENEW)
L7: LAC 1,ENEW↔POP3J
WASPS: 0
PCW 1,E↔CAMN 1,A↔GO W1
PCCW 1,E↔CAME 1,A↔GO W2
W1: SETZM A↔MARKZ E,WASP
PFACE. FNEW,E↔SETQ(E,{ECCW,E,FNEW})
TESTZ E,WASP↔GO W1↔GO @WASPS
W2: SETZM A↔MARKZ E,WASP
NFACE. FNEW,E↔SETQ(E,{ECCW,E,FNEW})
TESTZ E,WASP↔GO W2↔GO @WASPS
ENDR;1/14/73(BGB)----------------------------------------------------
SUBR(GLUEE,FACE1,VERT1,FACE2,VERT2) ;MAKE EDGE AND "HOLE".
COMMENT .---------------------------------------------------------.
;ENEW ← GLUEE(F1,V1,F2,V2) - LIKE TWO MKEV(F,V)'S BACK TO BACK.
ACCUMULATORS{F1,V1,F2,V2,B,E,E1,E2,E3,E4}
L0: CDR F1,FACE1↔CDR V1,VERT1↔PED E,F1↔CCW B,E
CDR F2,FACE2↔CDR V2,VERT2↔PED E,F2↔CCW 1,E
DAC E,E0#↔CAMN 1,B↔GO L1
;REPLACE B2 WITH B1 IF THEY ARE DIFFERENT.
LAC E,1↔PED E,E↔CAME E,1↔GO[CCW. B,E↔GO .-2]
PFACE E1,1↔NFACE E2,1↔NFACE E3,B
PFACE. E1,E3↔NFACE. E3,E1
PFACE. B,E2↔NFACE. E2,B
PED E1,1↔NED E2,1↔NED E3,B
PED. E1,E3↔NED. E3,E1
PED. B,E2↔NED. E2,B
PVT E1,1↔NVT E2,1↔NVT E3,B
PVT. E1,E3↔NVT. E3,E1
PVT. B,E2↔NVT. E2,B
CALL(KLB,1)↔GO L0
;REPLACE F2 WITH F1.
L1: PFACE 1,E↔CAMN 1,F2↔PFACE. F1,E
NFACE 1,E↔CAMN 1,F2↔NFACE. F1,E
SETQ(E,{ECCW,E,F1})↔CAME E,E0↔GO L1
CALL(KLF,F2)
COMMENT . GLUEE MANDALA
| | |
| +V2 |
| / | \ |
| / | \ |
NCCW | E2/ | \E1 | PCW
| / | \ |
| / F2 | F2 \ |
o______ | ______o
| HOWEVER,
WASP | ENEW GLUEE RETURN'S ENEW INVERTED
o______ | ______o
|\ | /|
| \ F1 | F1 / |
| \ | / |
NCW | E3\ | /E4 | PCCW
| \ | / |
| \ | / |
| -V1 |
| | |
| | | .
;EDGE CREATION
SETQ(E,{MKE,B})
MARK E,WASP
NFACE. F1,E↔PFACE. F1,E
NVT. V1,E↔PVT. V2,E
;MAKE WINGS
SETQ(E1,{ECW,V2,F1})↔PCW. E1,E
SETQ(E2,{ECW,E1,V2})↔NCCW. E2,E
SETQ(E3,{ECW,V1,F1})↔NCW. E3,E
SETQ(E4,{ECW,E3,V1})↔PCCW. E4,E
PVT 1,E1↔CAME 1,V2↔GO[PCCW. E,E1↔GO .+2]↔NCCW. E,E1
PVT 1,E2↔CAME 1,V2↔GO[NCW. E,E2↔GO .+2]↔PCW. E,E2
PVT 1,E3↔CAME 1,V1↔GO[PCCW. E,E3↔GO .+2]↔NCCW. E,E3
PVT 1,E4↔CAME 1,V1↔GO[NCW. E,E4↔GO .+2]↔PCW. E,E4
;MARK WASP WAIST ON POTENTIAL SPUR STARTING AT V1.
CAME E1,E2↔GO L2
MARK E1,WASP↔PVT V1,E1↔PED E1,V1
MOVS 1,1(E1)↔CAMN 1,1(E1)↔GO .-5
L2: LAC 1,E↔CALL(INVERT,1)↔POP4J
ENDR GLUEE;1/14/73(BGB)----------------------------------------------
SUBR(KLBFEV,Q) ;KILL B.F.E.V. ENTITY.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{B,F,E,V}
L0: LAC B,Q
TESTZ B,FBIT↔GO[CALL(FKILL,B)↔POP1J]
TESTZ B,EBIT↔GO[CALL(EKILL,B)↔POP1J]
TESTZ B,VBIT↔GO[CALL(KLEV,B)↔POP1J]
SETQ(B,{BGET,B})↔CALL(BDET,B)
SON 1,B↔JUMPE 1,L1↔CALL(KLBFEV,1)↔GO L0
L1: PFACE F,B↔CAME F,B↔GO[CALL(KLF,F)↔GO L1]
L2: PED E,B↔CAME E,B↔GO[CALL(KLE,E)↔GO L2]
L3: PVT V,B↔CAME V,B↔GO[CALL(KLV,V)↔GO L3]
CALL(KLB,B)↔POP1J
ENDR;1/13/73(BGB)----------------------------------------------------
SUBN(FKILL,FACE)
COMMENT .----------------------------------------------------------.
LAC 1,FACE↔TEST 1,FBIT↔POP1J↔DAC 1,F
PED 2,1↔DAC 2,E
SETQ(V0,{VCW,E,F})
SETQ(V,{VCCW,E,F})↔MOVSI XWC(1)↔HRRI X↔BLT Z
SETQ(A,{ECCW,E,F})
SETQ(F,{KLFE,E})
MOVEI 1↔DAC N
L1: LAC 1,A↔DAC 1,E
PVT 0,1↔CAMN 0,V↔GO[CALL(INVERT,E)↔GO .+1]
SETQ(A,{ECCW,A,F})
SETQ(V,{KLVE,E})
LAC XWC(1)↔FADM X
LAC YWC(1)↔FADM Y
LAC ZWC(1)↔FADM Z↔AOS N
CAME 1,V0↔GO L1
;PLACE VERTEX AT CENTER OF DECEASED FACE.
LAC 2,N↔FLOAT 2,
LAC X↔FDVR 2↔DAC XWC(1)
LAC Y↔FDVR 2↔DAC YWC(1)
LAC Z↔FDVR 2↔DAC ZWC(1)
POP1J
DECLARE{F,E,V,V0,A,X,Y,Z,N}
ENDR;2/10/73(BGB)----------------------------------------------------
SUBN(EKILL,EDGE)
COMMENT .----------------------------------------------------------.
;PLACE PVT AT MIDPOINT OF E.
LAC 1,EDGE↔TEST 1,EBIT↔POP1J ;EDGE ARGUMENT.
PFACE 0,1↔DAC F1↔NFACE 0,1↔DAC F2 ;SAVE FACES.
NVT 2,1↔PVT 1,1
LAC XWC(1)↔FADR XWC(2)↔FSC -1↔DAC XWC(1)
LAC YWC(1)↔FADR YWC(2)↔FSC -1↔DAC YWC(1)
LAC ZWC(1)↔FADR ZWC(2)↔FSC -1↔DAC ZWC(1)
CALL(KLVE,EDGE)↔DAC 1,V
;KILL TWO SIDED FACES WHEN THEY OCCUR.
LAC 1,F1↔PED 1,1
LAC 0,4(1)↔XOR 0,5(1)
TRNE 0,-1↔TLNN 0,-1
GO[CALL(KLFE,1)↔GO .+1]
LAC 1,F2↔PED 1,1
LAC 0,4(1)↔XOR 0,5(1)
TRNE 0,-1↔TLNN 0,-1
GO[CALL(KLFE,1)↔GO .+1]
LAC 1,V↔POP1J
DECLARE{F1,F2,V}
ENDR;11/21/73(BGB)---------------------------------------------------
SUBR(KLFE,EDGE) ;KILLS EDGE AND NFACE(EDGE) RETURNS PFACE(EDGE).
COMMENT .----------------------------------------------------------.
ACCUMULATORS{ENEW,FNEW,V1,V2,E1,E2,E3,E4,E,F,B}
;PICK THINGS UP.
CDR ENEW,EDGE
PFACE F,ENEW↔ NFACE FNEW,ENEW
PVT V1,ENEW↔ NVT V2,ENEW
;TEST FOR WASP EDGE CASE.
CAME F,FNEW↔GO L0
CALL(UNGLUE,ENEW)
POP1J
;GET THE WINGS.
L0: PCW E1,ENEW↔NCCW E2,ENEW
NCW E3,ENEW↔PCCW E4,ENEW
;GET RID OF ENEW APPEARANCES IN F & V.
PED 0,V1↔ CAMN 0,ENEW↔ PED. E1,V1
PED 0,V2↔ CAMN 0,ENEW↔ PED. E3,V2
PED 0,F ↔ CAMN 0,ENEW↔ PED. E3,F
;GET RID OF FNEW APPEARANCES
LAC E,E2
L1: CALL(ECCW,E,FNEW) ;GET NEXT EDGE ABOUT FNEW.
PFACE 0,E↔CAMN 0,FNEW↔GO[PFACE. F,E↔GO L2]
NFACE 0,E↔CAMN 0,FNEW↔GO[NFACE. F,E↔GO L2]
FATAL(KLFE)
L2: CAME E,E3↔GO[DAC 1,E↔GO L1]
;LINK WINGS TOGETHER ABOUT F.
CALL(WING,E2,E1)
CALL(WING,E4,E3)
;GET RID OF FNEW AND ENEW.
CCW B,ENEW
CALL(KLF,FNEW)
CALL(KLE,ENEW)
LAC 1,F↔POP1J
ENDR;1/14/73(BGB)----------------------------------------------------
SUBR(KLEV,EV) ;KILLS V AND PED(V). RETURNS OTHER E.
COMMENT .-----------------------------------------------------------
\ pvt / KLEV MANDALA
\ /
nccw \ / pcw
\ /
V ⊗
|
ENEW |
| nvt
VNEW ⊗
| pvt
E |
|
⊗
/ \
ncw / \ pccw
/ \
/ nvt \ .
ACCUMULATORS{E,ENEW,V,VNEW,F,B}
;CHECK FOR KILL WIRE CASE.
L0: CDR VNEW,EV
TEST VNEW,VBIT↔GO[CALL(KLVE,EV)↔POP1J] ;EDGE KILL
PED ENEW,VNEW
SETQ(E,{ECCW,ENEW,VNEW})
CAMN E,ENEW↔GO[
SETQ(V,{OTHER,ENEW,VNEW})
SETQ(E,{ECCW,ENEW,V})
CAMN E,ENEW↔GO[ ;ONE EDGED WIRE CASE.
PFACE F,E↔SETZ
PED. 0,F↔PED. 0,V
CALL(KLV,VNEW)↔CALL(KLE,E)
LAC 1,V↔POP1J]
NCW. E,E↔PCCW. E,E
GO L1]
;CHECK FOR VERTEX VALENCE GREATER THAN 2 CASE.
CALL(ECCW,E,VNEW)↔CAME 1,ENEW
GO[CALL(KLFE,ENEW)↔GO L0]
;ORIENT EDGES AS IN MANDALA.
NVT 0,ENEW↔CAMN 0,VNEW↔GO .+3↔CALL(INVERT,ENEW)
PVT 0,E↔CAMN 0,VNEW↔GO .+3↔CALL(INVERT,E)
;TIE E TO ITS NEW VERTEX.
PVT V,ENEW↔ PVT. V,E
;MAKE E'S UPPER WINGS LIKE ENEW'S.
PCW 0,ENEW↔CALL(WING,0,E)
NCCW 0,ENEW↔CALL(WING,0,E)
;ELIMINATE OCCURENCES OF ENEW IN F & V.
L1: PED 0,V↔ CAMN 0,ENEW↔ PED. E,V
PFACE F,E↔ PED 0,F↔ CAMN 0,ENEW↔ PED. E,F
NFACE F,E↔ PED 0,F↔ CAMN 0,ENEW↔ PED. E,F
;BURN THE GARBAGE.
CALL(KLV,VNEW)↔CALL(KLE,ENEW)
LAC 1,E↔MOVS 1(1)↔CAMN 1(1)↔NVT 1,1
POP1J
ENDR KLEV;1/14/73(BGB)-----------------------------------------------
SUBN(KLVE,EDGE) ;KILLS EDGE & NVT(EDGE). RETURNS PVT(E).
COMMENT .-----------------------------------------------------------
E2 \ / E1
nccw \ / pcw
\ /
pvt ⊗ V2
|
| E
|
nvt ⊗ V1
/ \
ncw / \ pccw
E3 / \ E4.
ACCUMULATORS{A,E,E1,E2,E3,E4,V1,V2,S12}
;PICK THINGS UP.
CDR E,EDGE↔NVT V1,E↔PVT V2,E
PCW E1,E↔NCCW E2,E↔NCW E3,E↔PCCW E4,E
;REPLACE FACE-VERTEX PED'S THAT MIGHT CONTAIN E.
PFACE 1,E↔PED 0,1↔CAMN 0,E↔PED. E1,1
NFACE 1,E↔PED 0,1↔CAMN 0,E↔PED. E2,1
PED 0,V2↔CAMN 0,E↔PED. E2,V2
;REPLACE V1 WITH V2.
LAC A,E3
L1: PVT 1,A↔CAME 1,V1↔GO[NVT. V2,A↔GO .+2]↔PVT. V2,A
SETQ(A,{ECCW,A,V2})
CAME A,E↔GO L1
;SPLICE WINGS TOGETHER.
CALL(WING,E1,E4)
CALL(WING,E2,E3)
;BURN THE GARBAGE.
CALL(KLE,E)↔CALL(KLV,V1)
LAC 1,V2↔POP1J
ENDR;1/14/73(BGB)-----------------------------------------------------
SUBR(UNGLUE,EDGE) ;RETURN'S FNEW
COMMENT .-----------------------------------------------------------.
;EULER'S EQUATION: F - E +V = 2*(B - H )
;CASE 1: KILLS AN EDGE & A HOLE & MAKES A FACE: 1 -(-1)+0 = 2*(0 -(-1))
;CASE 2: KILLS AN EDGE & MAKES A FACE & A BODY: 1 -(-1)+0 = 2*(1 - 0 )
ACCUMULATORS{B,F,FNEW,E,E1,E2,V,B2,Q,R}
;FETCH WASP EDGE & ITS BODY AND FACE.
LAC E,EDGE↔PFACE F,E↔CCW B,E
;ELIMINATE THE WASP EDGE.
PVT V,E↔DAC V,Q
SETQ(E1,{ECCW,E,V})↔SETQ(E2,{ECW,E,V}) ;FETCH WINGS OF PVT(E).
CALL(WING,E1,E2)↔PED. E1,V
PED. E1,F↔NVT V,E
SETQ(E1,{ECCW,E,V})↔SETQ(E2,{ECW,E,V}) ;FETCH WINGS OF NVT(E).
CALL(WING,E1,E2)↔PED. E1,V↔CALL(KLE,E)
;MAKE NEW FACE FOR ONE OF THE PERIMETERS.
SETQ(FNEW,{MKF,B})↔LAC E,E1
L00: CALL(ECCW,E,F)
PFACE 0,E↔CAMN 0,F↔PFACE. FNEW,E
NFACE 0,E↔CAMN 0,F↔NFACE. FNEW,E
LAC E,1↔CAME E,E1↔GO L00↔PED. E,FNEW
;MARK ALL THE FACES, EDGES AND VERTICES OF ONE BODY.
PVT V,E↔SETZM 6(V)
L0: MARK V,TBIT1
L1: PED E1,V↔LAC E,E1
L2: TEST E,TBIT1↔GO[ MARK E,TBIT1
PFACE F,E↔MARK F,TBIT1
NFACE F,E↔MARK F,TBIT1
CALL(OTHER,E,V)
TESTZ 1,TBIT1↔GO .+1
ALT. V,1↔LAC V,1↔GO L0] ;PUSH VERTEX.
SETQ(E,{ECCW,E,V})↔CAME E,E1↔GO L2
ALT V,V↔SKIPE V↔GO L1 ;POP VERTEX.
;PLACE ALL THE MARKED F.E.V. ON A NEW BODY.
LAC B2,B↔TESTZ Q,TBIT1↔GO L6 ;KILL HOLE.
SETQ(B2,{MKB,B}) ;MAKE BODY.
L3: SKIPA F,B↔SKIPA F,R↔PFACE F,F
TESTZ F,TBIT1↔GO .+4↔CAMN F,B↔GO L4↔GO L3+2
NFACE Q,F↔PFACE R,F↔PFACE. R,Q↔NFACE. Q,R↔NFACE Q,B2
PFACE. F,Q↔NFACE. F,B2↔NFACE. Q,F↔PFACE. B2,F↔GO L3+1
L4: SKIPA E,B↔SKIPA E,R↔PED E,E
TESTZ E,TBIT1↔GO .+4↔CAMN E,B↔GO L5↔GO L4+2
NED Q,E↔PED R,E↔PED. R,Q↔NED. Q,R↔NED Q,B2
PED. E,Q↔NED. E,B2↔NED. Q,E↔PED. B2,E↔CCW. B2,E↔GO L4+1
L5: SKIPA V,B↔SKIPA V,R↔PVT V,V
TESTZ V,TBIT1↔GO .+4↔CAMN V,B↔GO L6↔GO L5+2
NVT Q,V↔PVT R,V↔PVT. R,Q↔NVT. Q,R↔NVT Q,B2
PVT. V,Q↔NVT. V,B2↔NVT. Q,V↔PVT. B2,V↔GO L5+1
L6: MOVE[TBIT1+TMPBIT]
LAC F,B2↔PFACE F,F↔CAME F,B2↔GO[ANDCAM(F)↔GO .-2]
LAC E,B2↔PED E,E↔CAME E,B2↔GO[ANDCAM(E)↔GO .-2]
LAC V,B2↔PVT V,V↔CAME V,B2↔GO[ANDCAM(V)↔GO .-2]
LAC 1,FNEW↔POP1J
ENDR UNGLUE;1/11/74(BGB)---------------------------------------------
SUBR(GLUE,FACE1,FACE2)
COMMENT .----------------------------------------------------------.
;ARGUMENTS MUST BE FACES WITH THE SAME NUMBER OF VERTICES.
LAC 1,FACE1↔DAC 1,F1↔TEST 1,FBIT↔POP2J
LAC 1,FACE2↔DAC 1,F2↔TEST 1,FBIT↔POP2J
LAC 1,F1↔PED 2,1↔DAC 2,E↔DAC 2,E0↔MOVEI 10,1
L1: SETQ(E,{ECCW,E,F1})↔CAME 1,E0↔AOJA 10,L1↔DAC 10,NN
LAC 1,F2↔PED 2,1↔DAC 2,E↔DAC 2,E0↔SOS 10
L2: SETQ(E,{ECCW,E,F2})↔CAME 1,E0↔SOJA 10,L2↔SKIPE 10↔POP2J
;FIND V2 CLOSEST TO V1.
LAC 1,F1↔PED 2,1↔SETQ(V1,{VCW,2,1})
HRLOI 377777↔DAC MIN
SETZM LIST1↔SETZM LIST2
L3: SETQ(V,{VCW,E,F2})
CALL(DISTAN↑,V,V1)
CAMGE 1,MIN↔GO[DAC 1,MIN↔LAC V↔DAC V2↔GO .+1]
LAC 1,E↔LAC LIST1↔DAP -1(1)↔DAC 1,LIST1
; LAC 1,V↔LAC LIST2↔DAP -1(1)↔DAC 1,LIST2
SETQ(E,{ECCW,E,F2})
CAME 1,E0↔GO L3
CALL(GLUEE,F1,V1,F2,V2)
CALL(INVERT,1)
LAC LIST2↔DAP -1(1)↔DAC 1,LIST2
;CLOSE UP THE GAP.
SOS NN
L4: PCCW 0,1↔PUSH P,0↔PCW 0,1↔PUSH P,0
SETQ(V2,{OTHER,V2})↔SETQ(V1,{OTHER,V1})
CALL(MKFE,V2,F1,V1)
LAC LIST2↔DAP -1(1)↔DAC 1,LIST2
SOSLE NN↔GO L4
;NOW KILL ALL THOSE EDGES.
L5: SKIPN 1,LIST1↔GO L6↔CDR 0,-1(1)↔DAC 0,LIST1
CALL(KLFE,1)↔GO L5
L6: SKIPN 1,LIST2↔GO L7↔CDR 0,-1(1)↔DAC 0,LIST2
CALL(KLVE,1)↔GO L6
L7: LAC 1,F1↔PED 1,1↔CCW 1,1 ;BODY GET.
POP2J
DECLARE{F1,F2,V,V1,V2,NN,E,E0,MIN,LIST1,LIST2}
ENDR GLUE;2/10/73(BGB)-----------------------------------------------
SUBR(MKCOPY,BODY)
COMMENT .----------------------------------------------------------.
ACCUMULATORS{B,F,E,V,BNEW,Q,A}
LAC B,BODY
;DETECT AND COPY FRAME NODES
MOVM 1,(B) ;GET ABS(TYPE(NODE))
SKIPE 1↔TLNE 1,(<1B9>) ;IF ZERO OR BIT 9, THEN FLOATING
GO[ CALL(MKNODE,[0]) ;COPY FRAME NODE AND RETURN IT
MOVSI XWC(B)↔HRRI XWC(1)↔BLT KZ(1)
POP1J]
;IF IT ISN'T BODY, CHECK FOR FACE OR EDGE.
TESTZ B,BBIT↔GO DOBODY
TESTZ B,FBIT↔GO DOFACE
TESTZ B,EBIT↔GO DOEDGE
POP1J ;FORGET IT.
;COPY FACE INTO A NEW BODY.
DOFACE: DAC B,OLDF↔PED E,B
SETQ(B,{BGET,OLDF}) ;BODY OF THE GIVEN FACE.
SETQ(BNEW,{MKB,[0]}) ;NEW BODY IN NOW WORLD.
FRAME Q,B↔SKIPE Q↔GO[ ;COPY BODY FRAME, IF ANY.
CALL(MKFRAME↑)↔FRAME. 1,BNEW
MOVSI XWC(Q)↔HRRI XWC(1)↔BLT KZ(1)
GO .+1]
SETQ(FACE,{MKF,BNEW})
SETQ(V,{MKV,BNEW})↔DAC V,V0
SETQ(A,{VCW,E,OLDF})↔DAC A,A0
L0: MOVSI XWC(A)↔HRRI XWC(V)↔BLT ZWC(V) ;COPY VERTEX LOCUS.
SETQ(A,{VCCW,E,OLDF}) ;ADVANCE A VERTEX.
SETQ(E,{ECCW,E,OLDF})
CAMN A,A0↔GO[ ;TEST FOR END.
CALL(MKFE,V0,FACE,V)↔LAC 1,FACE↔POP1J] ;MAKE LAST EDGE.
PUSHP A↔PUSHP E
SETQ(V,{MKEV,FACE,V})
POPP E↔POPP A
GO L0
DECLARE{OLDF,A0,V0,FACE,V1,V2}
DOEDGE: DAC B,E
PFACE F,E↔DAC F,FACE
PCW 1,E↔DAC 1,V1
PCCW 1,E↔DAC 1,V2
PVT 1,E↔DAC 1,A0
NVT 1,E↔DAC 1,V0
SETQ(V1,{ESPLIT,V1})↔LAC 2,A0
MOVSI XWC(2)↔HRRI XWC(1)↔BLT ZWC(1) ;COPY VERTEX LOCUS.
SETQ(V2,{ESPLIT,V2})↔LAC 2,V0
MOVSI XWC(2)↔HRRI XWC(1)↔BLT ZWC(1) ;COPY VERTEX LOCUS.
CALL(MKFE,V1,FACE,V2)
POP1J
;MAKE A NEW BODY NODE
DOBODY: SETQ(BNEW,{MKB,[0]})
FRAME Q,B↔SKIPE Q ;COPY BODY FRAME, IF ANY
GO[ CALL(MKFRAME)↔FRAME. 1,BNEW
MOVSI XWC(Q)↔HRRI XWC(1)↔BLT KZ(1)
GO .+1]
;COPY THRU BODY'S FACE RING
LAC B,BODY↔LAC F,B↔LAC E,B↔LAC V,B
;FOR ALL THE EDGES OF THE BODY.
L1: PED E,E↔TEST E,EBIT↔GO L2
SETQ(Q,{MKE,BNEW})↔ALT. Q,E↔GO L1
;FOR ALL THE FACES OF THE BODY.
L2: PFACE F,F↔TEST F,FBIT↔GO L3
SETQ(Q,{MKF,BNEW})↔ALT. Q,F
PED A,F↔ALT A,A↔PED. A,Q
LAC QQ(F)↔DAC QQ(Q)↔GO L2
;FOR ALL THE VERTICES OF THE BODY.
L3: PVT V,V↔TEST V,VBIT↔GO L4
SETQ(Q,{MKV,BNEW})↔ALT. Q,V
PED A,V↔ALT A,A↔PED. A,Q
MOVSI XWC(V)↔HRRI XWC(Q)↔BLT ZWC(Q)
MOVSI XPP(V)↔HRRI XPP(Q)↔BLT YPP(Q)↔GO L3
;FOR ALL THE EDGES OF THE BODY.
L4: PED E,E↔TEST E,EBIT↔GO L5
ALT Q,E
PVT V,E↔ ALT V,V↔PVT. V,Q
NVT V,E↔ ALT V,V↔NVT. V,Q
PFACE F,E↔ALT F,F↔PFACE. F,Q
NFACE F,E↔ALT F,F↔NFACE. F,Q
NCW A,E↔ ALT A,A↔NCW. A,Q
PCW A,E↔ ALT A,A↔PCW. A,Q
NCCW A,E↔ ALT A,A↔NCCW. A,Q
PCCW A,E↔ ALT A,A↔PCCW. A,Q↔GO L4
L5: SETZ↔LAC 1,BNEW↔SKIPA E,BODY
L6: ALT. 0,E↔PED E,E↔CAME E,BODY↔GO L6
;PARTS OF THIS BODY.
LAC B,BODY↔TESTZ B,BDPBIT↔POP1J
SON Q,B↔JUMPE Q,POP1J.
L7: PUSH P,Q↔PUSH P,BNEW↔CALL(MKCOPY,Q)
LAC BNEW,(P)↔CALL(BATT,1,BNEW)
POP P,BNEW↔POP P,Q↔LAC B,BODY
BRO Q,Q↔SON 0,B↔CAME 0,Q↔GO L7
LAC 1,BNEW↔POP1J
ENDR MKCOPY;1/14/73(BGB)---------------------------------------------
SUBR(SWEEP,FACE0,FLAG)
COMMENT .-----------------------------------------------------------
U2 o----------o U1 FACE SWEEP MANDALA
/ \ / \
/ \ FNEW / \
/ \____/ \
/ v2 v1 \
/ F \.
;TEST FOR VALID ARGUMENT.
LAC 1,FACE0↔DAC 1,F↔TEST 1,FBIT↔POP2J
PED 2,1↔DAC 2,E↔SKIPN 2↔POP2J
TEST 2,EBIT↔POP2J
HLRE 0,FLAG↔DAC 0,CURFLG↔HRRES FLAG ;SET CURVE FLAG.
;TEST FOR SPECIAL CASES.
PCW 3,2↔CAMN 3,2↔GO[
CALL(SWEEP2,FACE0,FLAG)↔POP2J] ;WIRE SWEEP CASE.
SETZM E0↔NCNT 0,1↔MOVMM NN
SKIPE↔SETZM FLAG
;MAKE FIRST SPOKE.
CALL(VCW,E,F)↔DAC 1,U0↔DAC 1,U1
CALL(MKEV,F,U0)↔DAC 1,V0↔DAC 1,V1
PED 2,1↔MOVSI (NSHARP)↔SKIPE CURFLG↔ORM (2) ;SET NSHARP FOR CURVES
;COPY FACE PERIMETER LOOP.
L1: SETQ(U2,{VCCW,E,F}) ;ADVANCE ALONG RIM.
SETQ(E,{ECCW,E,F})
LAC 1,U2↔CAME 1,U0 ;MAKE NEXT SPOKE.
GO[CALL(MKEV,F,U2)↔SKIPN CURFLG↔GO .+2
PED 2,1↔MARK 2,NSHARP↔GO .+2] ;SET NSHARP FOR CURVES
LAC 1,V0↔DAC 1,V2
CALL(MKFE,V1,F,V2) ;CONNECT SPOKES.
SKIPN E0↔DAC 1,E0 ;NEW FIRST EDGE.
;SPLIT NEW FACE TO MAKE PRISMOIDS.
NFACE 0,1
SKIPGE FLAG↔GO[CALL(MKFE,V1,0,U2)↔GO .+3] ;CW -1.
SKIPLE FLAG↔GO[CALL(MKFE,U1,0,V2)↔GO .+1] ;CCW +1.
;TEST FOR END OF COPY LOOP.
LAC V2↔DAC V1
LAC U2↔DAC U1
SOSN NN↔GO .+3
CAME U0↔GO L1 ;EXIT WHEN NN=0 OR U2=U0
;EXIT.
LAC 0,E0↔LAC 1,F
PED. 0,1↔POP2J
DECLARE{F,E,E0,U0,U1,U2,V0,V1,V2,NN}
ENDR SWEEP;2/7/73(BGB)-----------------------------------------------
DECLARE{CURFLG}
SUBN(SWEEP2,FACE0,FLAG)
COMMENT . ⊗ ⊗-------⊗ ⊗-------⊗
+ | | | | |
PED(F) | | | | |PED(F)'
- | | | | |
⊗ ⊗ ⊗ V1→ ⊗-------⊗ ←V2
+ | | | | |
| | FNEW | F below | |
- | | | | |
⊗ ⊗ ⊗ ⊗ FNEW ⊗
+ | | | | |
| | | | |
- | | | | |
⊗ ⊗-------⊗ ⊗-------⊗ .
HLRE 1,FLAG↔DAC CURFLG↔HRRES FLAG ;SET CURVE FLAG.
;COUNT THE EDGES IN THE WIRE.
LAC 3,FACE0↔DAC 3,FACE ;FACE
PED 1,3↔MOVEI 0,1 ;EDGE & NCNT.
LAC 2,1↔NCW 1,1
CAME 1,2↔AOJA 0,.-3 ;COUNT THE EDGES.
;MAKE "BOTTOM" EDGE.
DAC 1,E ;LAST EDGE.
NCNT. 0,3↔DAC NN
NVT 1,1 ;LAST VERTEX OF THE WIRE.
SETQ(V2,{MKEV,FACE,1}) ;BOTTOM EDGE.
PED 1,1
MOVSI (NSHARP)↔SKIPE CURFLG↔ORM (1) ;SET NSHARP FOR CURVES
;COPY THE WIRE.
L1: SETQ(V2,{MKEV,FACE,V2})
LAC 3,E↔PVT 2,3↔DAC 2,V1
MOVSI XWC(2)↔HRRI XWC(1)↔BLT ZWC(1)
PCW 2,3↔DAC 2,E↔CAME 2,3↔GO L1
;CLOSE THE TOP.
SETQ(E,{MKFE,V1,FACE,V2})
MOVSI (NSHARP)↔SKIPE CURFLG↔ORM (1) ;SET NSHARP FOR CURVES
NFACE 1,1↔DAC 1,FNEW
SOSG NN↔GO L3
;FOLLOW DOWN BOTH SIDES.
L2: CALL(ECCW,E,FNEW)↔SETQ(V1,{OTHER,1,V1})
CALL(ECW,E,FNEW)↔SETQ(V2,{OTHER,1,V2})
SETQ(E,{MKFE,V2,FNEW,V1})
MOVSI (NSHARP)↔SKIPE CURFLG↔ORM (1) ;SET NSHARP FOR CURVES
SOSLE NN↔GO L2
;UPDATE THE FIRST EDGE OF THE FACE.
L3: LAC 2,FACE0↔PED 1,2
CALL(ECCW,1,2)↔PED. 1,2
LAC 1,2↔POP2J
DECLARE{FACE,FNEW,NN,V1,V2,E}
ENDR SWEEP2;2/7/73(BGB)----------------------------------------------
SUBR(ROTCOM,FACE0) ;ROTATION SWEEP COMPLETION.
COMMENT .-----------------------------------------------------------
⊗---⊗---⊗----⊗---⊗
| GAP | ← POLE CAP
| ↓ |
⊗-----⊗←←←←⊗-----⊗ ← ARTIC CIRCLE
PED(F)→| |
| |
V1' ⊗←←←←⊗ V2'
| F |
| |
⊗-----⊗ ⊗-----⊗ ← ANTARTIC CIRCLE.
ACCUMULATORS{F,E,E0,M,N}
LAC F,FACE0↔DAC F,FACE↔TEST F,FBIT↔POP1J
NCNT N,F↔MOVMM N,NN↔SKIPN↔POP1J
;COUNT THE EDGES IN THIS FACE.
MOVEI M,1↔PED E,F↔DAC E,E0↔DAC E,EDGE
L1: SETQ(E,{ECCW,E,F})
CAME E,E0↔AOJA M,L1
;SKIP AROUND THE NORTH POLE CAP.
ASH M,-1↔SUB M,NN
SETQ(V1,{VCW,EDGE,FACE})
LAC 1,EDGE
L2: CALL(ECW,1,FACE)↔SOJG M,L2
SETQ(V2,{VCW,1,FACE})
SETQ(EDGE,{MKFE,V2,FACE,V1}) ;CLOSE THE TOP OF THE GAP.
;FOLLOW DOWN THE GAP.
L3: CALL(ECCW,EDGE,FACE)↔SETQ(V1,{OTHER,1,V1})
CALL(ECW,EDGE,FACE)↔SETQ(V2,{OTHER,1,V2})
SETQ(EDGE,{MKFE,V2,FACE,V1})
SOSLE NN↔GO L3
SETZ↔LAC 1,FACE↔NCNT. 0,1
POP1J
DECLARE{FACE,EDGE,V1,V2,NN}
ENDR;2/8/73(BGB)-----------------------------------------------------
SUBR(PYRAMID,FV) ;MAKE PYRAMID.
COMMENT .----------------------------------------------------------.
LAC 1,FV↔TEST 1,VBIT↔GO L2
;VERTEX ARGUMENT - GIVEN THE PEAK FORM THE BASE.
DAC 1,V
PED 2,1↔DAC 2,E0↔DAC 2,E2
SETQ(V2,{OTHER,E2,V})
L1: LAC E2↔DAC E1
LAC V2↔DAC V1
SETQ(E2,{ECCW,E1,V})
SETQ(V2,{OTHER,E2,V})
CALL(LINKED,V1,V2)↔JUMPE 1,[ ;WHEN NOT LINKED.
CALL(FCCW,E1,V)
CALL(MKFE,V1,1,V2)↔GO .+1]
LAC E2↔CAME E0↔GO L1
LAC 1,FV↔POP1J
DECLARE{V,V1,V2,E0,E1,E2}
;FACE ARGUMENT - GIVEN THE BASE FORM THE PEAK.
L2: DAC 1,F↔TEST 1,FBIT↔POP1J
SETZM X↔SETZM Y↔SETZM Z↔SETZM N
PED 2,1↔DAC 2,E↔DAC 2,E0
SETQ(V0,{VCW,E0,F})
SETQ(PEAK,{MKEV,F,V0})
L3: SETQ(V,{VCCW,E,F})
LAC XWC(1)↔FADRM X
LAC YWC(1)↔FADRM Y
LAC ZWC(1)↔FADRM Z
AOS N↔CAMN 1,V0↔GO L4
SETQ(E,{ECCW,E,F})
CALL(MKFE,PEAK,F,V)
GO L3
L4: LAC 1,PEAK↔LAC 2,N↔FLOAT 2,
LAC X↔FDVR 2↔DAC XWC(1)
LAC Y↔FDVR 2↔DAC YWC(1)
LAC Z↔FDVR 2↔DAC ZWC(1)
POP1J
DECLARE{PEAK,F,E,V0,X,Y,Z,N}
ENDR;2/8/73(BGB)------------------------------------------------------
SUBR(FVDUAL,BODY) ;MAKE FACE-VERTEX DUAL.
COMMENT .----------------------------------------------------------.
ACCUMULATORS{B,F,E,V,E0,X,Y,Z,I}
LAC B,BODY↔TEST B,BBIT↔POP1J ;BODY ARGUMENT.
;FOR ALL THE FACES OF THE BODY.
LAC F,B
L1: PFACE F,F↔CAMN F,BODY↔GO L3 ;SCAN FACE RING.
SETZB X,Y↔SETZB Z,I ;ZERO X,Y,Z SUMS.
PED E,F↔DAC E,E0 ;FIRST EDGE OF FACE.
;COMPUTE CENTER OF EACH FACE.
L2: SETQ(V,{VCCW,E,F})↔SETQ(E,{ECCW,E,F}) ;SCAN FACE PERIMETER.
FAD X,XWC(V)↔FAD Y,YWC(V)↔FAD Z,ZWC(V) ;ACCUMULATE LOCII.
AOS I↔CAME E,E0↔GO L2 ;COUNT THE EDGES.
;CONVERT FACES INTO VERTICES.
FLOAT I,↔FDVR X,I↔FDVR Y,I↔FDVR Z,I ;AVERAGE LOCUS.
DAC X,XWC(F)↔DAC Y,YWC(F)↔DAC Z,ZWC(F) ;LOCUS OF "FACE".
SETZM 4(F)↔SETZM 5(F) ;CLEAR COLOR BYTES.
LAC 0,1(F)↔DAC 0,3(F) ;MOVE RING LINKS: F TO V.
MOVE [VBIT+$VERT]↔DAC(F)↔GO L1 ;RESET TYPE BITS: F TO V.
;CONVERT VERTICES INTO FACES.
L3: LAC V,BODY↔LAC 1,[FBIT+$FACE] ;RESET TYPE BITS: V TO F.
L4: PVT V,V↔CAMN V,BODY↔GO L5 ;SCAN VERTEX RING.
LAC 3(V)↔DAC 1(V)↔DAC 1,(V)↔GO L4 ;MOVE RING LINKS: V TO F.
;TURN ALL THE EDGES OVER AND INSIDE OUT.
E ←← V ;E ← BODY.
L5: PED E,E↔LAC 1(E)↔EXCH 3(E)↔DAC 1(E) ;FACES ↔ VERTICES.
CAMN E,BODY↔POP1J↔MOVSS 1(E) ;RETURNS THE BODY.
MOVS 0,4(E)↔LAC 1,5(E) ;NCW ←NCCW & PCW ←PCCW.
DAC 1,4(E)↔DAC 0,5(E)↔GO L5 ;NCCW ←PCW & PCCW← NCW.
ENDR FVDUAL;2/10/73(BGB)---------------------------------------------
SUBR(MKCUBE,DX,DY,DZ)
COMMENT .----------------------------------------------------------.
SETQ(B,{MKB,[0]}) ;MAKE SEMINAL BODY.
CALL(MKFRAME)↔LAC 2,B↔FRAME. 1,2 ;FRAME OF REFERENCE.
SETQ(F,{MKF,B})
SETQ(V,{MKV,B})
LAC DX↔FSC -1↔DAC XWC(1) ;POSITION 1ST VERTEX.
LAC DY↔FSC -1↔DAC YWC(1)
LAC DZ↔FSC -1↔DAC ZWC(1)
CALL(MKEV,F,1)↔MOVNS XWC(1) ;SWEEP WIRE SQUARE.
CALL(MKEV,F,1)↔MOVNS YWC(1)
CALL(MKEV,F,1)↔MOVNS XWC(1)
CALL(MKFE,V,F,1)↔LAC 1,B ;MAKE LAMINA.
SKIPN DZ↔POP3J ;RETURN LAMINA.
CALL(SWEEP,F,[0])↔LAC 1,B
NVT 1,1↔MOVNS ZWC(1) ;PLACE LOWER VERTICES.
NVT 1,1↔MOVNS ZWC(1)
NVT 1,1↔MOVNS ZWC(1)
NVT 1,1↔MOVNS ZWC(1)
LAC 1,B↔POP3J ;RETURN NEW BODY.
DECLARE{B,F,V}
ENDR MKCUBE;3/16/73(BGB)--------------------------------------------
SUBR(MKCYLN,RADIUS,N,DZ)
COMMENT .----------------------------------------------------------.
SETQ(B,{MKB,[0]}) ;MAKE SEMINAL BODY.
CALL(MKFRAME)↔LAC 2,B↔FRAME. 1,2;FRAME OF REFERENCE.
SETQ(F,{MKF,B})
SETQ(V,{MKV,B})↔DAC 1,V0
MOVM DZ↔FSC -1↔DAC ZWC(1) ;PICKUP ARGUMENTS.
MOVM RADIUS↔DAC XWC(1)
MOVM N↔FIXX↔CAIGE 3↔MOVEI 3
DAC CNT↔SOS CNT ;NUMBER OF SIDES-1.
FLOAT↔LAC 1,TWOPI↑
FDVR 1,0↔DAC 1,DELTA ;DELTA RADIANS.
L1: SETQ(V,{MKEV,F,V}) ;SWEEP WIRE POLYGON.
CALL(ROTATE↑,V,[0],[0],DELTA)
SOSLE CNT↔GO L1
CALL(MKFE,V0,F,V)↔LAC 1,B ;CLOSE WIRE - MAKING LAMINA.
SKIPN DZ↔POP3J ;RETURN LAMINA.
CALL(SWEEP,F,[0]) ;SWEEP FACE INTO SOLID.
MOVN DZ
CALL(TRANSL↑,F,[0],[0],0) ;POSITION LOWER FACE.
LAC 1,B↔POP3J ;RETURN NEW BODY.
DECLARE{DELTA,CNT,B,F,V,V0}
ENDR MKCYLN;7/19/73(BGB)----------------------------------------------
SUBR(MKBALL,RADIUS,M,N)
COMMENT .----------------------------------------------------------.
SETQ(B,{MKB,[0]}) ;MAKE SEMINAL BODY.
CALL(MKFRAME)↔LAC 2,B↔FRAME. 1,2;FRAME OF REFERENCE.
SETQ(F,{MKF,B})
SETQ(V,{MKV,B})↔DAC 1,V0
MOVM RADIUS↔MOVNM YWC(1)
;PICKUP LONGITUDE COUNT.
MOVM M↔FIXX↔CAIGE 2↔MOVEI 2
DAC CNT↔SOS CNT ;NUMBER OF LONGITUDES-1.
FLOAT↔LAC 1,PI↑
FDVR 1,0↔DAC 1,DELTA↔FSC 1,-1 ;DELTA RADIANS.
CALL(ROTATE↑,V0,[0],[0],1) ;SET OFF FROM POLAR AXIS.
;SWEEP MERIDIAN WIRE FROM ANTARTIC TO ARTIC.
L1: SETQ(V,{MKEV,F,V}) ;SWEEP WIRE POLYGON.
CALL(ROTATE↑,V,[0],[0],DELTA)
SOSLE CNT↔GO L1
;PICKUP LATITUDE COUNT.
MOVM N↔FIXX↔CAIGE 3↔MOVEI 3
DAC CNT↔SOS CNT ;NUMBER OF LATITUDES-1.
FLOAT↔LAC 1,TWOPI↑
FDVR 1,0↔MOVNM 1,DELTA ;DELTA RADIANS.
;SWEEP MERIDIAN WIRE INTO SHELL EAST TO WEST.
L2: CALL(SWEEP,F,[0])
CALL(ROTATE↑,F,[0],DELTA,[0])
SOSLE CNT↔GO L2↔CALL(ROTCOM,F) ;CLOSE THE SHELL
LAC 1,B↔POP3J
DECLARE{DELTA,CNT,B,F,V,V0}
ENDR MKBALL;7/19/73(BGB)---------------------------------------------
;TITLE BIN - BODY INTERSECTION - 7 MARCH 1973 - B.G.BAUMGART
EXTERN VERIFY,FACOEF
EXTERN WITH3D,SOLANG
EXTERN DPYBUF,DPYSET,DPYOUT
EXTERN QFEV,ECOEF
↓SURBIT←←1B2 ;VERTEX ON SURFACE.
↓OKBIT←←2B2
DEFINE QFACE(Q,V){CDR Q,7(V)}
DEFINE QFACE.(Q,V){DAP Q,7(V)}
DEFINE NAF (Q,E){CAR Q,-1(E)}
DEFINE NAF.(Q,E){DIP Q,-1(E)}
DEFINE PAF (Q,E){CDR Q,-1(E)}
DEFINE PAF.(Q,E){DAP Q,-1(E)}
DEFINE JALT(A,B){ALT. A,B↔ALT. B,A}
DEFINE JALTV(V,V.){ALT. V,V.↔ALT. V.,V
MOVSI XWC(V)↔HRRI XWC(V.)↔BLT ZWC(V.)}
DECLARE{FNEXT,ENEXT}
↓PZ ←←1B28
↓NZ ←←1B29
;BEAD FORMAT, BEADS LINK EDGES & WINDOWS FOR THE SAKE OF 2-D SORTING.
LEFT (WNBL,0) ;WINDOW'S BEAD LIST.
RIGHT(EDBL,0) ;EDGE'S BEAD LIST.
LEFT (WBEAD,1) ;WINDOW OF A BEAD.
RIGHT(EBEAD,1) ;EDGE OF A BEAD.
;SORT-WINDOW NODE FORMAT.
PENCNT ←← -3 ;PENETRATING FACE COUNT.
SURCNT ←← -2 ;SURROUNDING FACE COUNT.
EDGCNT ←← -1 ;EDGE COUNT.
;SWINDO PDL 0 ;PREVIOUS SWINDO.
;NFACE,,PFACE 1 ;SUROUNDER FACE LIST,,PENETRATOR FACE LIST.
; NED,,PED 2 ;LAST EDGE BEAD,,FIRST EDGE BEAD.
XLO←←3 ↔ XHI←← 4 ;WINDOW'S BOUNDARIES
YLO←←5 ↔ YHI←← 6 ;IN FLOATING FORMAT.
; VCNT,,CCW 7 ;VERTEX LIST THRU CCW LINKS.
;CUTFLG ←← 8 ;0 IN X, -1 IN Y.
SUBR(BIN,B1,B2) COMPUTE BODY OF INTERSECTION.
COMMENT .-----------------------------------------------------------.
L0: LAC 1,B1↔TEST 1,BBIT↔POP2J↔CALL(FACOEF,1)
LAC 1,B2↔TEST 1,BBIT↔POP2J↔CALL(FACOEF,1)
LAC 1,B1↔PVT 1,1↔CAMN 1,B1↔GO .+3↔SETZM ZPP(1)↔GO .-4
LAC 1,B2↔PVT 1,1↔CAMN 1,B2↔GO .+3↔SETZM ZPP(1)↔GO .-4
CALL(FESORT,B1,B2) ;FACE EDGE 3-D SPACE SORT.
;....................................................................
L3A: ;OUTSTR[ASCIZ/END OF FACE-EDGE COMPARES..../]↔CRLF
L3: CALL(GETSURV,B1)↔GO L4
CALL(GETSURV,B2)↔GO L4↔GO L5
L4: CALL(QHOLE,1) ;CHECK OUT A POTENTIAL HOLE.
GO L3 ;NO HOLE YET.
; OUTSTR[ASCIZ/FOUND HOLE.../]↔CRLF
CALL(KLSURV,B1) ;HOLE FACE WAS PYRAMID'ED.
CALL(KLSURV,B2) ;START OVER.
GO L0
L5: CALL(MKB,[0])↔DAC 1,BODY0
CALL(MKFRAME)↔LAC 2,BODY0↔ALT2. 1,2
LAC 1,B1
NVT 1,1↔TESTZ 1,VBIT↔GO[
TEST 1,SURBIT↔GO .-3
ALT 0,1↔SKIPE↔GO .-3
CALL(MKSURF,1,1)
POP P,1↔GO .-3]
LAC 1,B2
NVT 1,1↔TESTZ 1,VBIT↔GO[
TEST 1,SURBIT↔GO .-3
ALT 0,1↔SKIPE↔GO .-3
CALL(MKSURF,1,1)
POP P,1↔GO .-3]
L6: CALL(FIXUP1)
CALL(KLBFEV↑,B1)
CALL(KLBFEV↑,B2)
LAC 1,BODY0↔POP2J
ENDR BIN;3/7/73(BGB)-------------------------------------------------
BODY0: 0
SUBR(BUN,B1,B2) BODY UNION.
COMMENT .-----------------------------------------------------------.
CALL(EVERT,B2)↔CALL(EVERT,B1)
CALL(BIN,B1,B2)
PUSHP 1↔CALL(EVERT,1) ;SAVE RESULT.
POPP 1↔POP2J ;RETURN RESULT.
ENDR BUN;3/10/73(BGB)------------------------------------------------
SUBR(BSUB,B1,B2) BODY SUBTRACTION BNEW ← (B1-B2).
COMMENT .-----------------------------------------------------------.
CALL(EVERT,B2)
CALL(BIN,B1,B2)
POP2J
ENDR BSUB;3/10/73(BGB)-----------------------------------------------
SUBN(FESORT,B1,B2) ;COMPARE FACES AND EDGES FOR INTERSECTIONS.
COMMENT .---------------------------------------------------------------------.
;COUNT THE NUMBER OF COMPFE CALLS.
SETZ↔LAC 1,B2↔PED 1,1↔CAME 1,B2↔AOJA .-2↔PUSHP
SETZ↔LAC 1,B1↔PED 1,1↔CAME 1,B1↔AOJA .-2↔PUSHP
SETZ↔LAC 1,B2↔PFACE 1,1↔CAME 1,B2↔AOJA .-2↔PUSHP
SETZ↔LAC 1,B1↔PFACE 1,1↔CAME 1,B1↔AOJA .-2↔PUSHP
POPP 1↔POPP 2↔POPP 3↔POPP 4
IMUL 1,4↔IMUL 2,3↔ADD 1,2
;COMPARE ALL THE EDGES OF ONE WITH ALL THE FACES OF THE OTHER.
LAC 1,B1↔LAC 2,B2
PFACE 2,2↔CAME 2,B2↔GO[
PED 1,1↔CAMN 1,B1↔GO .-2↔TESTZ 1,100↔GO @.
CALL(COMPFE,2,1)↔POP P,1↔POP P,2↔GO @.]
PFACE 1,1↔CAME 1,B1↔GO[
PED 2,2↔CAMN 2,B2↔GO .-2↔TESTZ 2,100↔GO @.
CALL(COMPFE,1,2)↔POP P,2↔POP P,1↔GO @.]
POP2J
; CALL(MKSWN,FACE,EDGE)
;SPLIT DIFFICULT SORT-WINDOWS UNTIL THEY ARE SIMPLE.
L1: JFCL;CALL(SWNDPY↑)
LAC 1,SWINDO↑
CDR EDGCNT(1)
CAMG ELIMIT↔GO L2
CALL(PSHSWN↑)↔GO L1
L2: CALL(XXXXXX)
CALL(POPSWN↑)
SKIPE SWINDO↔GO L1
POP2J
ELIMIT: =10
ENDR FESORT;BGB 18 APRIL 1974 -------------------------------------------------
SUBR(XXXXXX)
LAC 1,SWINDO
POP0J
ENDR XXXXXX
SUBR(COMPFE,FACE,EDGE) ;COMPARE FACE EDGE 3D FOR PIERCING.
COMMENT .------------------------------------------------------------
V2 ← PVT ⊗ Q2 < K ABOVE F,
| ENEW
____|_____________________
/ | /
/ ⊗ V FACE F /
/_________________________/
|
| E
V1 ← NVT ⊗ Q1 > K BELOW-F.
ACCUMULATORS{X,Y,Z,V1,V2,E,F}
;CHECK ARGUMENTS FOR FRESHNESS.
LAC E,EDGE↔LAC F,FACE
NVT V1,E↔PVT V2,E
QFACE 1,V1↔CAMN 1,F↔POP0J
QFACE 1,V2↔CAMN 1,F↔POP0J
;DIRECTED DISTANCE V1 FROM FACE.
LAC 0,AA(F)↔FMP 0,XWC(V1)
LAC 1,BB(F)↔FMP 1,YWC(V1)↔FAD 0,1
LAC 1,CC(F)↔FMP 1,ZWC(V1)↔FAD 0,1↔DAC Q1#
;DIRECTED DISTANCE V2 FROM FACE.
LAC 0,AA(F)↔FMP 0,XWC(V2)
LAC 1,BB(F)↔FMP 1,YWC(V2)↔FAD 0,1
LAC 1,CC(F)↔FMP 1,ZWC(V2)↔FAD 0,1↔DAC Q2#
;DOES EDGE PASS THRU THE PLANE OF THIS FACE.
LAC KK(F)
CAMG Q1↔GO .+3↔CAMLE Q2↔POP0J
CAML Q1↔GO .+3↔CAMGE Q2↔POP0J
FSB 0,Q1↔LAC 1,Q2↔FSB 1,Q1
FDVR 0,1↔SKIPL↔CAMLE[1.0]↔POP0J↔DAC 1
;SOLVE FOR PLANE PIERCING LOCUS.
LAC X,XWC(V1)↔LAC XWC(V2)↔FSB X↔FMP 1↔FADM X
LAC Y,YWC(V1)↔LAC YWC(V2)↔FSB Y↔FMP 1↔FADM Y
LAC Z,ZWC(V1)↔LAC ZWC(V2)↔FSB Z↔FMP 1↔FADM Z
CALL(WITH3D,F,X,Y,Z)↔POP0J
LAC E,EDGE↔LAC F,FACE↔ADD P,[XWD 4,4]
;MAKE FACE PIERCING POINT.
LAC KK(F)↔CAMLE Q1↔GO[CALL(INVERT,E)↔GO .+1]
CALL(ESPLIT,E)↔MARK 1,SURBIT
POP P,ZWC(1)↔POP P,YWC(1)↔POP P,XWC(1)↔POP P,0
QFACE. 0,1↔LAC 2,EDGE↔PED. 2,1↔POP0J
ENDR COMPFE;3/7/73---------------------------------------------------
SUBR(OTHERV,FACE,VERTEX) ;FETCH OTHER VERTEX PIERCING FACE.
COMMENT ;-----------------------------------------------------------
F1 PIERCES F2 AT V2 CASE. F2 PIERCES F1 AT V2 CASE.
______________ ________
| | | |
| F2 | | F2 |
______|......... | ______|........|_____
| ↓ . | | ↓ ↓ |
| F1 ⊗V1 ⊗V2 | | F1 ⊗V1 ⊗V2 |
|_______________↑ | |_____________________|
| | | |
|______________| |________| ;
ACCUMULATORS{F1,F2,V1,E,E0}
SAVAC(6)
LAC F2,FACE
LAC V1,VERTEX
QFACE F1,V1
;DOES F1 PIERCE F2 AT V2.
PED E,F1↔DAC E,E0
L1: CALL(VCCW,E,F1)
QFACE 0,1
CAMN 0,F2↔GO L4
SETQ(E,{ECCW,E,F1})
CAME E,E0↔GO L1
;DOES F2 PIERCE F1 AT V2.
PED E,F2↔DAC E,E0
L2: CALL(VCCW,E,F2)
CAMN 1,V1↔GO .+4
QFACE 0,1
CAMN 0,F1↔GO L4
SETQ(E,{ECCW,E,F2})
CAME E,E0↔GO L2
FATAL(OTHERV)
L4: GETAC(6)↔POP2J
ENDR OTHERV;3/8/73(BGB)----------------------------------------------
SUBN(KLSURV,B) KILL SURFACE VERTICES OF A BODY.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{V}
LAC V,B
L: NVT V,V↔CAMN V,B↔POP1J ;SCAN FOR...
TEST V,SURBIT↔GO L ;PIERCING VERTICES.
NVT V,V↔PUSH P,V↔PVT V,V ;SAVE NEXT...
CALL(KLEV↑,V)↔POP P,V ;KILL THIS VERTEX.
GO L+1
ENDR KLSURV;3/23/73(BGB)---------------------------------------------
SUBN(OKSURV,VERTEX) MARK A SURFACE LOOP AND MAKE ITS LIST.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{V}
LAC V,VERTEX↔PED 1,V ;FIRST EDGE.
PFACE 1,1↔DAC 1,FACE# ;FACE BELONGINF TO V.
QFACE 1,V↔DAC 1,OLDQF# ;FACE PIERCED BY V.
L: MARK V,OKBIT↔PUSH P,V
CALL(OTHERV,FACE,V) ;FOLLOW SURV LOOP ACROSS.
POP P,V
CAMN 1,VERTEX↔GO[
SETZ↔ALT2. 0,V↔POP1J] ;NIL AT END OF LIST.
ALT2. 1,V↔DAC 1,V ;OLDE V POINTS AT NEW V.
QFACE 0,V↔LAC 1,FACE ;NEXT FACE.
CAME 0,OLDQF↔LAC 1,OLDQF
DAC 0,OLDQF↔PED 0,V
SETQ(FACE,{OTHER,0,1})
GO L
ENDR OKSURV;3/23/73(BGB)---------------------------------------------
SUBN(GETSURV,B) GET AN UNMARKED SURFACE VERTEX OF A BODY OR SKIP.
COMMENT .-----------------------------------------------------------.
LAC 1,B
L: NVT 1,1
CAMN 1,B↔GO[AOS(P)↔POP1J]
TEST 1,SURBIT↔GO L
TESTZ 1,OKBIT↔GO L
POP1J
ENDR GETSURV;3/23/73(BGB)--------------------------------------------
SUBN(MKSURF,VERTEX) MAKE SURFACE EDGES AND VERTICES.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{A,V1,V2,F,QF,FLG}
LAC V2,VERTEX↔PED 1,V2
SETZM FLG ;FOR ORIENTING THE FACES OF NEW EDGES.
SETQ(F,{FCCW,1,V2}) ;FACE BELONGING TO V.
QFACE QF,V2 ;FACE PIERCED BY V.
CALL(MKV,BODY0)↔JALTV(V2,1) ;MAKE FIRST SURFACE VERTEX.
L1: LAC V1,V2
SETQ(V2,{OTHERV,F,V1}) ;FOLLOW SURFACE LOOP.
CALL(ETRACE,V2)
CAMN V2,VERTEX↔GO L2
CALL(MKV,BODY0)↔JALTV(V2,1) ;MAKE SURFACE VERTEX.
L2: SETQ(A,{MKE,BODY0}) ;MAKE SURFACE EDGE.
ALT 1,V1↔NVT. 1,A↔PED. A,1 ;LINK A TO ITS VERTICES.
ALT 1,V2↔PVT. 1,A↔NED. A,1
NFACE. QF,A↔PFACE. F,A ;LINK A TO ALEIN FACES.
SKIPE FLG↔MOVSS 1(A)
CAMN V2,VERTEX↔POP1J ;TEST FOR END OF PHASE-1.
QFACE 0,V2↔LAC 1,F ;NEXT FACE.
CAMN 0,QF↔GO .+3
LAC 1,QF↔SETCMM FLG
DAC 0,QF↔PED 0,V2 ;NEW PIERCED FACE.
SETQ(F,{OTHER,0,1})↔GO L1
ENDR MKSURF;5/9/74(BGB)----------------------------------------------
SUBN(ETRACE,VERTEX) ;TRACE INTERIOR EDGES & VERTICES.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{E,E0,V}
SAVAC(4)
LAC V,VERTEX↔PED E,V↔GO L2 ;STARTING FROM A SURV.
L0: CALL(MKV,BODY0)↔JALTV(V,1) ;MAKE INTERIOR VERTEX.
L1: PED E,V↔DAC E,E0
L2: ALT 1,E↔JUMPN 1,L3 ;IS EDGE ALREADY TRACED ?
CALL(MKE,BODY0)↔JALT(1,E) ;MAKE INTERIOR EDGE.
LAC 1(E)↔DAC 1(1) ;COPY THE FACE LINKS.
L3: CALL(OTHER,E,V)
TESTZ 1,SURBIT↔GO L4 ;DON'T TRACE SURV'S.
ALT 0,1↔JUMPN 0,L4 ;IS VERTEX ALREADY TRACED ?
ALT2. V,1↔LAC V,1↔GO L0 ;PUSH VERTEX
L4: CAMN V,VERTEX↔GO L5
SETQ(E,{ECCW,E,V})
CAME E,E0↔GO L2
ALT2 V,V↔SKIPE V↔GO L1 ;POP VERTEX
L5: GETAC(4)↔POP1J
ENDR ETRACE;5/9/74(BGB)----------------------------------------------
SUBN(FIXUP1)
COMMENT .-----------------------------------------------------------.
;FIX UP VERTEX AND WING POINTERS OF ALL NON-SURFACE EDGES.
ACCUMULATORS{A,E,V,Q}
LAC A,BODY0
L1: PED A,A↔CAMN A,BODY0↔GO L2-1 ;POP0J
ALT E,A↔JUMPE E,L1 ;SURFACE EDGES HAVE ALT ZERO.
PVT V,E↔ ALT V,V↔PVT. V,A↔PED 0,V↔SKIPN↔PED. A,V
NVT V,E↔ ALT V,V↔NVT. V,A↔PED 0,V↔SKIPN↔PED. A,V
NCW Q,E↔ ALT Q,Q↔NCW. Q,A
PCW Q,E↔ ALT Q,Q↔PCW. Q,A
NCCW Q,E↔ALT Q,Q↔NCCW. Q,A
PCCW Q,E↔ALT Q,Q↔PCCW. Q,A↔GO L1
;....................................................................
;FIXUP2: WING TOGETHER THE SURFACE VERTEX TRIHEDRAL CORNERS.
ACCUMULATORS{U,V,A1,A2,A3}
LAC U,BODY0
L2: PVT U,U↔CAMN U,BODY0↔GO L3-1 ;POP0J
ALT V,U
TEST V,SURBIT↔GO L2
PED 1,V↔ALT A1,1
PED A2,U↔NED A3,U↔HRRZS 2(U)
CALL(WING,A1,A2)
CALL(WING,A1,A3)
CALL(WING,A2,A3)↔GO L2
;....................................................................
;FIXUP3: REPLACE ALEIN FACES WITH NATIVE FACES.
ACCUMULATORS{A,A0,E,F1,F2}
LAC A,BODY0
L3: PED A,A↔CAMN A,BODY0↔POP0J
SETZ↔ALT. 0,A ;CLEAR EDGE ALT LINKS OF BODY0.
PFACE F1,A↔PUSHJ P,L4
NFACE F1,A↔PUSHJ P,L4↔GO L3
L4: PED E,F1↔CCW 1,E ;SUB-SUBROUTINE TO REPLACE A FACE.
CAMN 1,BODY0↔POPJ P,
SETQ(F2,{MKF,BODY0})↔PED. A,F2
DAC A,A0
L5: CALL(ECCW,A,F1)
PFACE 0,A↔CAMN 0,F1↔PFACE. F2,A
NFACE 0,A↔CAMN 0,F1↔NFACE. F2,A
DAC 1,A↔CAME A,A0↔GO L5↔POPJ P,
ENDR FIXUP1;---------------------------------------------------------
SUBN(QHOLE,VERTEX) DETECT AND PYRAMID POTENTIAL PIERCE HOLES.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{V}
CALL(OKSURV,VERTEX)
;SECOND TIME AROUND - LOOK FOR DIFFERENT Q-FACES.
LAC V,VERTEX
QFACE 1,V↔DAC 1,QF#
L1: ALT2 V,V↔JUMPE V,L2
QFACE 0,V↔CAME 0,QF↔POP1J ;EXIT NO HOLE.
GO L1
L2: SETZM A#↔SETZM N#↔SETZM X#↔SETZM Y#↔SETZM Z#
;THIRD TIME AROUND - TAKE SUM OF SOLID INTERIOR ANGLES.
LAC V,VERTEX
L3: LAC XWC(V)↔FADRM X
LAC YWC(V)↔FADRM Y
LAC ZWC(V)↔FADRM Z
AOS N↔PUSH P,V
CALL(SOLANG,V)↔FADRM 1,A
POP P,V↔ALT2 V,V
SKIPE V↔GO L3
LAC 0,N↔FLOAT↔DAC 0,N
FSBRI(2.0)↔FMPR PI↑↔FSBR A
L4: MOVMS↔CAMGE[0.01]↔POP1J ;EXIT - NO HOLE.
CALL(PYRAMID↑,QF)
LAC X↔FDVR N↔DAC XWC(1)
LAC Y↔FDVR N↔DAC YWC(1)
LAC Z↔FDVR N↔DAC ZWC(1)
PED 2,1↔DAC 2,3↔DAC 1,4
L5: MARK 2,DARKEN↔SETQ(2,{ECCW,2,4})↔CAME 2,3↔GO L5
AOS(P)↔POP1J ;SKIP EXIT - HOLE.
ENDR QHOLE;3/23/73(BGB)----------------------------------------------
SUBR(MKCVEX)F MAKE CONVEX.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{F,E0,V,CNT,N,S,E,W,YMAX,YMIN,XMAX,XMIN}
;GET EXTREMA VERTICES.
MKCVX.:
LAC F,-1(P)↔DAC F,FACE1
TEST F,BBIT↔GO L0
L00: PFACE F,F↔CAMN F,-1(P)↔POP1J
PUSH P,F↔CALL(MKCVEX,F)↔POP P,F↔GO L00
L0: PED E0,F↔DAC E0,EDGE0
MOVEI CNT,1
MOVSI YMAX,400000
MOVSI XMAX,400000
SETCM YMIN,YMAX
SETCM XMIN,XMAX
L1: SETQ(V,{VCCW,E0,F})
CAMGE YMAX,YPP(V)↔GO[LAC YMAX,YPP(V)↔LAC N,V↔GO .+1]
CAMGE XMAX,XPP(V)↔GO[LAC XMAX,XPP(V)↔LAC E,V↔GO .+1]
CAMLE YMIN,YPP(V)↔GO[LAC YMIN,YPP(V)↔LAC S,V↔GO .+1]
CAMLE XMIN,XPP(V)↔GO[LAC XMIN,XPP(V)↔LAC W,V↔GO .+1]
SETQ(E0,{ECCW,E0,F})
CAME E0,EDGE0↔AOJA CNT,L1
;EXIT IF FACE1 IS ALREADY A TRIANGLE (OR LESS).
L1B: CAIG CNT,3↔POP1J
GO L6
;--------------------------------------------------------------------
;LOP OFF THE POINT WITH THE SMALLEST ANGLE ≡ LARGEST COSINE.
L5:
LAC V,-1(P)↔DAC V,VERT2
SETQ(EDGE1,{ECCW,VERT2,FACE1})
PVT 0,1↔CAMN 0,V↔GO .+3
CALL(INVERT,1)↔NVT 0,1↔DAC VERT3
SETQ(EDGE3,{ECW,VERT2,FACE1})
PVT 0,1↔CAMN 0,V↔GO .+3
CALL(INVERT,1)↔NVT 0,1↔DAC VERT1
CALL(ECOEF,EDGE1)
CALL(ECOEF,EDGE3)
LAC 2,EDGE1↔LAC 3,EDGE3
LAC 1,AA(2)↔FMPR 1,AA(3)
LAC 0,BB(2)↔FMPR 0,BB(3)↔FADR 1,0
LAC 0,-1(P)
SUB P,[2(2)]↔GO @2(P) ;"POP1J"
;--------------------------------------------------------------------
L6: CALL(,N,S,E,W)
MOVSI(<-2.0>)↔DAC TMP
CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
CALL(L5,VERT0)
SETQ(EDGE2,{MKFE,VERT1,FACE1,VERT3})
MARK 1,DARKEN+NSHARP
NFACE 1,1↔DAC 1,FACE2
CALL(FACOEF↑,FACE2)
;SCAN FACE1'S PERIMETER VERT1 TO VERT3.
HRLOI 377777↔DAC QMIN↔SETZM VERT4 ;INIT FOR CLOSEST VIOLATOR.
LAC EDGE2↔DAC EDGE0 ;INIT FOR FACE1 PERIMETER SCAN.
L2: SETQ(EDGE0,{ECCW,EDGE0,FACE1})
SETQ(VERT0,{VCCW,EDGE0,FACE1})
CAMN 1,VERT1↔GO L3
;TEST FOR VERTEX WITHIN THE TRIANGLE THAT WE ARE ABOUT TO LOP.
CALL(WITH3D,FACE2,{XWC(1)},{YWC(1)},{ZWC(1)})
GO L2 ;VERTEX IS NOT WITHIN THE TRIANGLE.
;FIND VERTEX WITHIN TRIANGLE, NEAREST VERT0.
CALL(DISTANCE↑,VERT0,VERT2)
CAML 1,QMIN↔GO L2
DAC 1,QMIN
LAC VERT0↔DAC VERT4
GO L2 ;CONTINUE THE SCAN.
;WHEN TRIANGLE IS UNVIOLATED THEN ITERATE.
L3: SKIPE VERT4↔GO L4
GO MKCVX.
;WHEN TRIANGLE HAS BEEN VIOLATED THEN RECURSE.
L4: CALL(KLFE,EDGE2)
CALL(MKFE,VERT2,FACE1,VERT4)
MARK 1,DARKEN
NFACE 1,1 ;START WORKING ON THE NEW FACE.
CALL(MKCVEX,1)
GO MKCVX. ;CONTINUE WORKING ON THE OLDE FACE.
DECLARE{FACE1,FACE2,TMP,QMIN}
DECLARE{EDGE0,EDGE1,EDGE2,EDGE3}
DECLARE{VERT0,VERT1,VERT2,VERT3,VERT4}
DEL: 0.01
ENDR MKCVEX;3/23/73(BGB)---------------------------------------------
SUBR(ESLURP,BODY) ;REMOVE UNNECESSARY EDGES.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{F1,F2,E1}
;Calculate face co-efficients for each face.
CALL(FACOEF↑,BODY)
;Go backwords thru ring of edges killing any darkened edges with
;co-planar faces.
LAC E1,BODY
LOOP: NED E1,E1
TEST E1,EBIT↔POP1J
PFACE F1,E1↔NFACE F2,E1
;Compare face co-efficients. Since it rans thru numerous FMPR's and
;SQRT we can't expect them to be exactly equal.
FOR @` I ε {XYZ}
< LAC I`WC(F1)↔FSBR I`WC(F2)
MOVM 0,0↔CAML 0,[0.000001]↔GO LOOP
> LAC 0,E1
;They're co-planar, now the angle on each vertex needs to be checked
;to make sure it's less than π radians.
MARK E1,DARKEN
PVT 1,E1↔DAC 1,V1
NVT 1,E1↔DAC 1,V2
;Do PVT
NCCW 1,E1↔SETQ V3,{OTHER↑,1,V1}
PCW 1,E1 ↔SETQ V4,{OTHER↑,1,V1}
PUSH P,E1
CALL(ANGL3V↑,V3,V1,V2) ;ANGL3V appears to return a value < π
MOVEM 1,T1 ;so both angles must be summed, instead
CALL(ANGL3V↑,V2,V1,V4) ;of just angle between CW and CCW edges.
FADR 1,T1
POP P,E1
CAML 1,PI↑↔GO LOOP
;Do NVT
PCCW 1,E1↔SETQ V3,{OTHER↑,1,V2}
NCW 1,E1 ↔SETQ V4,{OTHER↑,1,V2}
PUSH P,E1
CALL(ANGL3V↑,V3,V2,V1)↔DAC 1,T1
CALL(ANGL3V↑,V1,V2,V4)↔FADR 1,T1
POP P,E1
CAML 1,PI↑↔GO LOOP
;We found an unneeded edge, kill it!
NED 0,E1
PUSH P,0↔CALL(KLFE↑,E1)↔POP P,E1
GO LOOP+1
DECLARE{V1,V2,V3,V4,T1}
ENDR ESLURP;8/23/73(TVR)---------------------------------------------
SUBR(MKBUCK,BODY) ;MAKE BUCKET CUBE.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{B,V,XLO,XHI,YLO,YHI,ZLO,ZHI}
;FIND COORDINATE EXTREMA.
HRLOI XLO,377777↔HRLZI 400000
HRLOI YLO,377777↔HRLZI 400000
HRLOI ZLO,377777↔HRLZI 400000
LAC B,BODY↔LAC V,B
L1: PVT V,V↔CAMN V,B↔GO L2
CAMLE XLO,XWC(V)↔LAC XLO,XWC(V)↔CAMGE XHI,XWC(V)↔LAC XHI,XWC(V)
CAMLE YLO,YWC(V)↔LAC YLO,YWC(V)↔CAMGE YHI,YWC(V)↔LAC YHI,YWC(V)
CAMLE ZLO,ZWC(V)↔LAC ZLO,ZWC(V)↔CAMGE ZHI,ZWC(V)↔LAC ZHI,ZWC(V)
GO L1
;MAKE BOUNDS CUBE AND TRANSLATE IT TO PROPER POSITION.
L2: PUSH P,[0]
DAC XHI,0↔FSBR XHI,XLO↔FADR XLO,0↔FSC XLO,-1↔PUSH P,XLO
DAC YHI,0↔FSBR YHI,YLO↔FADR YLO,0↔FSC YLO,-1↔PUSH P,YLO
DAC ZHI,0↔FSBR ZHI,ZLO↔FADR ZLO,0↔FSC ZLO,-1↔PUSH P,ZLO
CALL(MKCUBE↑,XHI,YHI,ZHI)
DAC 1,BUCK#↔DAC 1,-3(P) ;PLACE BUCKET IN PDL.
CALL(TRANSLATE↑);"B,XLO,YLO,ZLO)" ;POSITION THE BUCKET.
LAC 1,BUCK↔POP1J
ENDR MKBUCK;1/15/74(BGB)---------------------------------------------
DECLARE{ZCUT,LIST1,FSET1,ELIST1,ELIST2,BSET1}
SUBR(ECUT,B,DX,DY,DZ)
COMMENT .-----------------------------------------------------------.
SETQ(FRM,{MKQFRM↑,DX,DY,DZ})
CALL(INTRAN↑,FRM)↔CALL(APTRAN↑,B,FRM)
CALL(VMARK,B)↔SETZM ELIST2↔SETOM CUTFLG
CALL(FECUT,B)
CALL(INTRAN↑,FRM)↔CALL(APTRAN↑,B,FRM)
CALL(KLNODE↑,FRM)↔POP4J
ENDR ECUT;3/6/74(BGB)------------------------------------------------
SUBR(FCUT,B,DX,DY,DZ)
COMMENT .-----------------------------------------------------------.
SETQ(FRM,{MKQFRM↑,DX,DY,DZ})
CALL(INTRAN↑,FRM)↔CALL(APTRAN↑,B,FRM)
CALL(VMARK,B)↔SETZM ELIST2↔SETZM CUTFLG
CALL(FECUT,B)
CALL(INTRAN↑,FRM)↔CALL(APTRAN↑,B,FRM)
CALL(KLNODE↑,FRM)↔POP4J
ENDR FCUT;3/6/74(BGB)------------------------------------------------
SUBN(VMARK,BODY) ;MARK THE VERTICES OF A BODY AS PZ OR NZ.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{V}
;CLEAR THE NZ AND PZ BITS OF ALL THE VERTICES.
SETZM PZCNT↔SETZM NZCNT
MOVEI PZ+NZ↔LAC 1,BODY
ANDCAM(1)↔PVT 1,1↔CAME 1,BODY↔GO .-3
;MARK THE VERTICES AS EITHER ABOVE OR BELOW ZERO XWC.
LAC V,BODY
L1: PVT V,V↔CAMN V,BODY↔POP1J
SKIPGE XWC(V)↔GO L2
MARK V,PZ↔AOS PZCNT↔GO L1 ;POSITIVE.
L2: MARK V,NZ↔AOS NZCNT↔GO L1 ;NEGATIVE.
ENDR VMARK;1/11/74(BGB)---------------------------------------------
DECLARE{PZCNT,NZCNT,CUTFLG,FRM}
SUBR(BCUT,B,DX,DY,DZ)
COMMENT .-----------------------------------------------------------.
SETQ(FRM,{MKQFRM↑,DX,DY,DZ})
CALL(INTRAN↑,FRM)↔CALL(APTRAN↑,B,FRM)
CALL(VMARK,B)↔SETZM ELIST2
MOVEI 1↔DAC CUTFLG↔CALL(FECUT,B) ;BODY CUT +1.
L1: SKIPN 2,ELIST2↔GO[
CALL(INTRAN↑,FRM)
CALL(APTRAN↑,B,FRM)
POP4J]
ALT2 1,2↔DAC 1,ELIST2↔DAC 2,ELIST1
;KILL THE TIES THAT BIND - MAPCAR KLFE DOWN THE ALT EDGE LIST 1.
L2: SKIPN 2,ELIST1↔GO L3
ALT 1,2↔DAC 1,ELIST1
PFACE 0,2↔DAC 0,FACE1
SETQ(FACE2,{KLFE,2})
GO L2
L3: LAC 1,FACE1↔LAC 2,FACE2 ;LINK TWO NEW FACES.
MARK 1,TMPBIT↔MARK 2,TMPBIT
ALT. 1,2↔ALT. 2,1
LAC 1,FACE1↔PED 1,1↔CCW 1,1↔CAME 1,B↔GO[CALL(BATT↑,1,B)↔GO .+1]
LAC 2,FACE2↔PED 2,2↔CCW 2,2↔CAME 2,B↔GO[CALL(BATT↑,2,B)↔GO .+1]
GO L1
DECLARE{EDGE,FACE1,FACE2}
ENDR BCUT;3/6/74(BGB)------------------------------------------------
SUBN(FECUT,BODY) ;FACE EDGE CUTTING.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{V2,V1,DX,DY,DZ}
;SCAN THE EDGES OF THE BODY FOR ZCUT CROSSINGS.
LAC 1,BODY↔DAC 1,EDGE#
L0: LAC 1,EDGE↔NED 1,1↔DAC 1,EDGE ;ADVANCE ALONG EDGE RING.
CAMN 1,BODY↔POP1J ;TEST FOR END OF EDGE RING.
PVT V1,1↔NVT V2,1 ;GET VERTICES.
LAC(V1)↔EQV(V2)
TESTZ(,PZ+NZ)↔GO L0 ;TEST FOR EDGE CROSSING.
;INITIALIZATION FOR FACE-EDGE CUT FOR A SINGLE SLICE FACE.
SETOM FLAG ;FIRST TIME THRU FLAG -1.
SETZM ELIST1↔LAC 1,EDGE ;LIST OF VERY SHORT EDGES.
DAC 1,E↔NVT 2,1↔TEST 2,PZ
GO[CALL(INVERT,E)↔GO .+1] ;FORCE NVT(E) INTO PZ HALF-SPACE.
LAC 1,E↔NFACE 1,1
DAC 1,F0↔DAC 1,F ;FIRST FACE.
;SPLIT EDGE - SO THAT PVT(E) IS IN NZ HALF SPACE.
L1: LAC 1,E
NVT V1,1↔PVT V2,1
PUSH P,V2↔PUSH P,V1 ;SAVE OLDE VERTICES.
TEST V1,PZ↔GO[
CALL(INVERT,E)↔GO .+1] ;FORCE NVT(E) INTO PZZ.
SETQ(U2,{ESPLIT,E})
; MARK 1,TMPBIT
MARK 1,PZ↔PED 1,1
SKIPLE CUTFLG↔GO[
LAC 2,ELIST1↔ALT. 2,1↔DAC 1,ELIST1
SETQ(UU2,{ESPLIT,ELIST1})
; MARK 1,TMPBIT
MARK 1,NZ↔GO .+1]
;COMPUTE LOCUS WHERE E INTERSECTS THE SLICE PLANE.
POP P,V1↔POP P,V2 ;RESTORE OLDE VERTICES.
LAC DX,XWC(V2)↔FSBR DX,XWC(V1)
LAC DY,YWC(V2)↔FSBR DY,YWC(V1)
LAC DZ,ZWC(V2)↔FSBR DZ,ZWC(V1)
MOVN 0,XWC(V1)↔FDVR 0,DX↔LAC 2,U2
FMPR DY,0↔FADR DY,YWC(V1)↔DAC DY,YWC(1)↔DAC DY,YWC(2)
FMPR DZ,0↔FADR DZ,ZWC(V1)↔DAC DZ,ZWC(1)↔DAC DZ,ZWC(2)
;FIRST TIME ONLY.
AOSG FLAG↔GO[
LAC U2↔DAC U0
LAC UU2↔DAC UU0
GO L2]
;SPLIT FACES.
SKIPL CUTFLG↔GO[
CALL(MKFE,U2,F,U1)↔ ;MARK 1,TMPBIT
NFACE 1,1
SKIPE CUTFLG↔GO[
CALL(MKFE,UU2,1,UU1)↔ ;MARK 1,TMPBIT
GO .+1]↔GO .+1]
;ADVANCE INTO THE NEXT FACE & FIND NEXT CROSSING EDGE.
L2: LAC U2↔DAC U1
LAC UU2↔DAC UU1
SETQ(F,{OTHER,E,F})
CAMN 1,F0↔GO L4
L3: SETQ(E,{ECCW,E,F})
CALL(VCCW,E,F)
TEST 1,NZ↔GO L3
GO L1
;DOUBLE CUT LAST (FIRST) FACE.
L4: SKIPGE CUTFLG↔GO L0
CALL(MKFE,U0,F,U1)↔ ;MARK 1,TMPBIT
NFACE 1,1
SKIPG CUTFLG↔GO L0
CALL(MKFE,UU0,1,UU1)↔ ;MARK 1,TMPBIT
LAC 1,ELIST1↔LAC 2,ELIST2
ALT2. 2,1
DAC 1,ELIST2↔SETZM ELIST1
GO L0
DECLARE{F,E,U0,U1,U2,F0,FLAG,UU0,UU1,UU2}
ENDR FECUT;1/11/74(BGB)---------------------------------------------
END